38 lines
1.6 KiB
Mathematica
38 lines
1.6 KiB
Mathematica
|
DGPTMSG1 ;ALB/AS - Format PTF Messages ; 7 NOV 89 @ 0800
|
||
|
|
;;5.3;Registration;**61**;Aug 13, 1993
|
||
|
|
;
|
||
|
|
DICN ; -- add message entry
|
||
|
|
I $P(^DG(43,1,0),"^",40)=0 S Y=-1 G DICNQ
|
||
|
|
DICN1 S DINUM=$P(^DGM(0),"^",3)
|
||
|
|
L S DINUM=DINUM+1 L ^DGM(DINUM):1 I '$T!($D(^DGM(DINUM))) L G L
|
||
|
|
S DIC="^DGM(",DIC("DR")="[DG PTF ADD MESSAGE]",DIC(0)="L",X=DINUM K DD,DO D FILE^DICN
|
||
|
|
DICNQ K DINUM,DIC Q
|
||
|
|
;
|
||
|
|
DS ;called for Deleted Discharge Date Message
|
||
|
|
S Y=$S($D(DGPMP):$E(+DGPMP,1,12),1:"") X ^DD("DD") S DGMSG="A discharge date"_$S($D(DGPMP):" of "_Y,1:" ")_" was deleted by "_$P(^VA(200,+DUZ,0),U)_". Please verify PTF files."
|
||
|
|
D MSG Q
|
||
|
|
;
|
||
|
|
MSG ; -- generic call to add DGMSG to PTF MESSAGE file
|
||
|
|
; input: DFN and DGMSG
|
||
|
|
;
|
||
|
|
D DICN
|
||
|
|
I +Y>0 S DA=+Y,DGADMTY=$P(DGPMAN,"^",4) D QU
|
||
|
|
K DGMSG,DGMSG1 Q
|
||
|
|
;
|
||
|
|
MOV ; -- called for Patient Admitted Message, Diagnosis Change Message
|
||
|
|
Q:'$D(DGPMCA)!('$D(DGPMDA))
|
||
|
|
K DGMSG D DICN G MOVQ:Y<0 S DA=+Y
|
||
|
|
F X=0:0 S X=$O(^DGPM(DGPMDA,"DX",X)) Q:X'>0 S ^DGM(DA,"M",X,0)=^DGPM(DGPMDA,"DX",X,0)
|
||
|
|
S ^DGM(DA,"M",0)=$S($D(^DGPM(DGPMDA,"DX",0)):^(0),1:"")
|
||
|
|
S DGADMTY=$P(^DGPM(DGPMCA,0),"^",4) D QU
|
||
|
|
MOVQ Q
|
||
|
|
;
|
||
|
|
QU ; -- que message to print
|
||
|
|
G QUQ:'$P(^DG(43,1,0),"^",31)
|
||
|
|
S DGADMTY=$S($D(DGADMTY):DGADMTY,1:""),DGMISD=""
|
||
|
|
I $D(^DIC(42,+$P(DGPMAN,"^",6),0)) S DGZ=$P(^(0),"^",11),DGMISD=$S($D(^DG(40.8,+DGZ,"DEV")):$P(^("DEV"),"^",4),1:"")
|
||
|
|
I DGMISD="" S DGMISD=$P(^DG(43,1,0),"^",19) G QUQ:DGMISD=""
|
||
|
|
S DGPGM="PR^DGPTMSG",DGVAR="DGADMTY^DA",ZTIO=DGMISD,DGUTQND=""
|
||
|
|
D Q1^DGUTQ I '$G(DGQUIET) W !!,"**** "_$S($D(DGMSG1):DGMSG1_" ",1:"")_"Message Transmitted to MIS ****",!
|
||
|
|
QUQ K DGMSG1,DGMSG,DGADMTY,DGPGM,DGUTQND,DGVAR,DIC,DGZ,X,Y,DA,DGMISD Q
|