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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTMSG1 1674 printed Sep 23, 2025@20:28:47 Page 2
DGPTMSG1 ;ALB/AS - Format PTF Messages ; 7 NOV 89 @ 0800
+1 ;;5.3;Registration;**61**;Aug 13, 1993
+2 ;
DICN ; -- add message entry
+1 IF $PIECE(^DG(43,1,0),"^",40)=0
SET Y=-1
GOTO DICNQ
DICN1 SET DINUM=$PIECE(^DGM(0),"^",3)
L SET DINUM=DINUM+1
LOCK ^DGM(DINUM):1
IF '$TEST!($DATA(^DGM(DINUM)))
LOCK
GOTO L
+1 SET DIC="^DGM("
SET DIC("DR")="[DG PTF ADD MESSAGE]"
SET DIC(0)="L"
SET X=DINUM
KILL DD,DO
DO FILE^DICN
DICNQ KILL DINUM,DIC
QUIT
+1 ;
DS ;called for Deleted Discharge Date Message
+1 SET Y=$SELECT($DATA(DGPMP):$EXTRACT(+DGPMP,1,12),1:"")
XECUTE ^DD("DD")
SET DGMSG="A discharge date"_$SELECT($DATA(DGPMP):" of "_Y,1:" ")_" was deleted by "_$PIECE(^VA(200,+DUZ,0),U)_". Please verify PTF files."
+2 DO MSG
QUIT
+3 ;
MSG ; -- generic call to add DGMSG to PTF MESSAGE file
+1 ; input: DFN and DGMSG
+2 ;
+3 DO DICN
+4 IF +Y>0
SET DA=+Y
SET DGADMTY=$PIECE(DGPMAN,"^",4)
DO QU
+5 KILL DGMSG,DGMSG1
QUIT
+6 ;
MOV ; -- called for Patient Admitted Message, Diagnosis Change Message
+1 if '$DATA(DGPMCA)!('$DATA(DGPMDA))
QUIT
+2 KILL DGMSG
DO DICN
if Y<0
GOTO MOVQ
SET DA=+Y
+3 FOR X=0:0
SET X=$ORDER(^DGPM(DGPMDA,"DX",X))
if X'>0
QUIT
SET ^DGM(DA,"M",X,0)=^DGPM(DGPMDA,"DX",X,0)
+4 SET ^DGM(DA,"M",0)=$SELECT($DATA(^DGPM(DGPMDA,"DX",0)):^(0),1:"")
+5 SET DGADMTY=$PIECE(^DGPM(DGPMCA,0),"^",4)
DO QU
MOVQ QUIT
+1 ;
QU ; -- que message to print
+1 if '$PIECE(^DG(43,1,0),"^",31)
GOTO QUQ
+2 SET DGADMTY=$SELECT($DATA(DGADMTY):DGADMTY,1:"")
SET DGMISD=""
+3 IF $DATA(^DIC(42,+$PIECE(DGPMAN,"^",6),0))
SET DGZ=$PIECE(^(0),"^",11)
SET DGMISD=$SELECT($DATA(^DG(40.8,+DGZ,"DEV")):$PIECE(^("DEV"),"^",4),1:"")
+4 IF DGMISD=""
SET DGMISD=$PIECE(^DG(43,1,0),"^",19)
if DGMISD=""
GOTO QUQ
+5 SET DGPGM="PR^DGPTMSG"
SET DGVAR="DGADMTY^DA"
SET ZTIO=DGMISD
SET DGUTQND=""
+6 DO Q1^DGUTQ
IF '$GET(DGQUIET)
WRITE !!,"**** "_$SELECT($DATA(DGMSG1):DGMSG1_" ",1:"")_"Message Transmitted to MIS ****",!
QUQ KILL DGMSG1,DGMSG,DGADMTY,DGPGM,DGUTQND,DGVAR,DIC,DGZ,X,Y,DA,DGMISD
QUIT
