DGPTMSG1.m

DGPTMSG1 ;ALB/AS - Format PTF Messages ; 7 NOV 89 @ 0800

 ;;5.3;Registration;**61,1015**;Aug 13, 1993;Build 21

 ;

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

DGPTMSG1  ;ALB/AS - Format PTF Messages ; 7 NOV 89 @ 0800

 +1       ;;5.3;Registration;**61,1015**;Aug 13, 1993;Build 21

 +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