| [613] | 1 | DGPTMSG1 ;ALB/AS - Format PTF Messages ; 7 NOV 89 @ 0800
|
|---|
| 2 | ;;5.3;Registration;**61**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | DICN ; -- add message entry
|
|---|
| 5 | I $P(^DG(43,1,0),"^",40)=0 S Y=-1 G DICNQ
|
|---|
| 6 | DICN1 S DINUM=$P(^DGM(0),"^",3)
|
|---|
| 7 | L S DINUM=DINUM+1 L ^DGM(DINUM):1 I '$T!($D(^DGM(DINUM))) L G L
|
|---|
| 8 | S DIC="^DGM(",DIC("DR")="[DG PTF ADD MESSAGE]",DIC(0)="L",X=DINUM K DD,DO D FILE^DICN
|
|---|
| 9 | DICNQ K DINUM,DIC Q
|
|---|
| 10 | ;
|
|---|
| 11 | DS ;called for Deleted Discharge Date Message
|
|---|
| 12 | 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."
|
|---|
| 13 | D MSG Q
|
|---|
| 14 | ;
|
|---|
| 15 | MSG ; -- generic call to add DGMSG to PTF MESSAGE file
|
|---|
| 16 | ; input: DFN and DGMSG
|
|---|
| 17 | ;
|
|---|
| 18 | D DICN
|
|---|
| 19 | I +Y>0 S DA=+Y,DGADMTY=$P(DGPMAN,"^",4) D QU
|
|---|
| 20 | K DGMSG,DGMSG1 Q
|
|---|
| 21 | ;
|
|---|
| 22 | MOV ; -- called for Patient Admitted Message, Diagnosis Change Message
|
|---|
| 23 | Q:'$D(DGPMCA)!('$D(DGPMDA))
|
|---|
| 24 | K DGMSG D DICN G MOVQ:Y<0 S DA=+Y
|
|---|
| 25 | 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)
|
|---|
| 26 | S ^DGM(DA,"M",0)=$S($D(^DGPM(DGPMDA,"DX",0)):^(0),1:"")
|
|---|
| 27 | S DGADMTY=$P(^DGPM(DGPMCA,0),"^",4) D QU
|
|---|
| 28 | MOVQ Q
|
|---|
| 29 | ;
|
|---|
| 30 | QU ; -- que message to print
|
|---|
| 31 | G QUQ:'$P(^DG(43,1,0),"^",31)
|
|---|
| 32 | S DGADMTY=$S($D(DGADMTY):DGADMTY,1:""),DGMISD=""
|
|---|
| 33 | 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:"")
|
|---|
| 34 | I DGMISD="" S DGMISD=$P(^DG(43,1,0),"^",19) G QUQ:DGMISD=""
|
|---|
| 35 | S DGPGM="PR^DGPTMSG",DGVAR="DGADMTY^DA",ZTIO=DGMISD,DGUTQND=""
|
|---|
| 36 | D Q1^DGUTQ I '$G(DGQUIET) W !!,"**** "_$S($D(DGMSG1):DGMSG1_" ",1:"")_"Message Transmitted to MIS ****",!
|
|---|
| 37 | QUQ K DGMSG1,DGMSG,DGADMTY,DGPGM,DGUTQND,DGVAR,DIC,DGZ,X,Y,DA,DGMISD Q
|
|---|
