DGPTMSG ;ALB/JDS/AS - PTF MESSAGE ENTRY/EDIT/PRINT ; 7 NOV 89 14:46
;;5.3;Registration;**164**;Aug 13, 1993
;
D LO^DGUTL
PAT K DIC("S") S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y,(DGMISD,DGADMTY)=""
I $D(^DPT(DFN,.1)) S D=$O(^DIC(42,"B",^(.1),0)) I D>0 S D=+$P(^DIC(42,D,0),"^",11),DGMISD=$S($D(^DG(40.8,+D,"DEV")):$P(^("DEV"),"^",4),1:"")
I DGMISD="" S DGMISD=$P(^DG(43,1,0),"^",19) G Q:DGMISD=""
K DGMSG D DICN1^DGPTMSG1 G Q:Y<0
S DA=+Y,DR="10",DIE="^DGM(" D ^DIE
I '$O(^DGM(DA,"M",0)) S DIK=DIE D ^DIK W !,"MESSAGE DELETED" G PAT
S DGPGM="PR^DGPTMSG",DGVAR="DGADMTY^DA",ZTIO=DGMISD,DGUTQND=""
D Q1^DGUTQ W !!,"***** MESSAGE SENT *****",*7,!!
G PAT
PR ;
U IO S RET="",L=$S($D(^DGM(+DA,0)):^(0),1:0) G Q:'L S DFN=$P(L,"^",2),L1=$S($D(^DPT(+DFN,0)):^(0),1:""),X="N",%DT="T" D ^%DT S NOW=Y W !!," Mess #: ",+L,?20,"Name: ",$E($P(L1,"^",1),1,27),?55," SSN: ",$P(L1,"^",9),!
S D=$P(L,"^",4) W "Entered: " W:D $TR($$FMTE^XLFDT(D,"5DF")," ","0") W ?22,"By: ",$S($D(^VA(200,+$P(L,"^",3),0)):$P(^(0),U,1),1:""),?55,"Ward: ",$S($D(^DPT(DFN,.1)):^(.1),1:"")
W !," Time: " W:D#1 $E(D,9,10),":",$E(D_"0000",11,12) W ?51,"Room/bed: ",$S($D(^DPT(DFN,.101)):^(.101),1:""),!
W "Printed: ",$TR($$FMTE^XLFDT(NOW,"5DF")," ","0"),?20,"Time: ",$E(NOW_"00000",9,10)_":"_$E(NOW_"00000",11,12)
W ?41,"Treating Specialty: ",$S($D(^DPT(DFN,.103)):$S($D(^DIC(45.7,+^(.103),0)):$P(^(0),U,1),1:""),1:""),!
I DGADMTY]"" W "Admission Type: ",$S($D(^DG(405.1,+DGADMTY,0)):$P(^(0),"^",1),1:"NOT SPECIFIED")
W ?51,"Provider: ",$S($D(^DPT(DFN,.104)):$S($D(^VA(200,+^(.104),0)):$P(^(0),U,1),1:""),1:""),!
S DIC="^DGM(",DR="M" K ^UTILITY($J) D EN^DIQ
S DR="4///NOW",DIE="^DGM(",DP=45.5 D ^DIE
I RET S DIE="^DGM(",DR="4///NOW;5///P",DP=45.5 D ^DIE
G QQ:$O(^DGM(DA,"E",0))'>0 W !,"Edited",?17,"Retran",?25,"By",! F I=1:1:60 W "="
F I=0:0 S I=$O(^DGM(DA,"E",I)) Q:I'>0 S L=^(I,0),D=+L W !,$TR($$FMTE^XLFDT(D,"5DF")," ","0"),"@",$E(D_"0000",9,10),":",$E(D_"00000",11,12),?17,$S($P(L,"^",3):"YES",1:"NO"),?25,$S($D(^VA(200,+$P(L,"^",2),0)):$P(^(0),U,1),1:"")
QQ D:IO]"" ^%ZISC Q
;
IN S DIC="^DGM(",DIC(0)="AEQMZ"
PA D ^DIC K DIC("S") G Q:Y'>0 S DA=+Y
S L=^DGM(DA,0),DFN=$P(L,"^",2),L1=^DPT(DFN,0),NOW=$P(L,U,5) W !!," Mess #: ",+L,?20,"Name: ",$E($P(L1,"^",1),1,27),?55," SSN: ",$P(L1,"^",9),!
S D=$P(L,"^",4) W "Entered: ",$TR($$FMTE^XLFDT(D,"5DF")," ","0"),?22,"By: ",$S($D(^VA(200,+$P(L,"^",3),0)):$P(^(0),U,1),1:""),?55,"Ward: ",$S($D(^DPT(DFN,.1)):^(.1),1:"")
W !," Time: ",$E(D,9,10),":",$E(D_"0000",11,12),?51,"Room/bed: ",$S($D(^DPT(DFN,.101)):^(.101),1:""),!
W "Printed: " W:NOW $TR($$FMTE^XLFDT(NOW,"5DF")," ","0") W ?22,"Time: " W:NOW $E(NOW_"00000",9,10)_":"_$E(NOW_"00000",11,12) W !
G M:+$P(L,U,7)'>0 S N=$P(L,U,7)_"00000" W "Chk off: ",$TR($$FMTE^XLFDT(N,"5DF")," ","0"),?22,"Time: ",$E(N,9,10)_":"_$E(N,11,12),?53,"By: ",$E($S($D(^VA(200,+$P(L,U,8),0)):$P(^(0),U,1),1:""),1,22),!
M S DIC="^DGM(",DR="M" D EN^DIQ
G PA:$O(^DGM(DA,"E",0))'>0 W !,"Edited",?17,"Retran",?25,"By",! F I=1:1:60 W "="
F I=0:0 S I=$O(^DGM(DA,"E",I)) Q:I'>0 S L=^(I,0),D=+L W !,$TR($$FMTE^XLFDT(D,"5DF")," ","0"),"@",$E(D_"0000",9,10),":",$E(D_"00000",11,12),?17,$S($P(L,"^",3):"YES",1:"NO"),?25,$S($D(^VA(200,+$P(L,"^",2),0)):$P(^(0),U,1),1:"")
W !! G PA
;
Q K DGADMTY,DGMISD,DGPGM,DGUTQND,DGVAR,%DT,D,DA,DIC,DIE,DIK,DP,DR,I,L,L1,N,NOW,RET,X,Y,ZTIO Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTMSG 3392 printed Apr 09, 2024@21:50:09 Page 2
DGPTMSG ;ALB/JDS/AS - PTF MESSAGE ENTRY/EDIT/PRINT ; 7 NOV 89 14:46
+1 ;;5.3;Registration;**164**;Aug 13, 1993
+2 ;
+3 DO LO^DGUTL
PAT KILL DIC("S")
SET DIC="^DPT("
SET DIC(0)="AEQMZ"
DO ^DIC
if Y'>0
GOTO Q
SET DFN=+Y
SET (DGMISD,DGADMTY)=""
+1 IF $DATA(^DPT(DFN,.1))
SET D=$ORDER(^DIC(42,"B",^(.1),0))
IF D>0
SET D=+$PIECE(^DIC(42,D,0),"^",11)
SET DGMISD=$SELECT($DATA(^DG(40.8,+D,"DEV")):$PIECE(^("DEV"),"^",4),1:"")
+2 IF DGMISD=""
SET DGMISD=$PIECE(^DG(43,1,0),"^",19)
if DGMISD=""
GOTO Q
+3 KILL DGMSG
DO DICN1^DGPTMSG1
if Y<0
GOTO Q
+4 SET DA=+Y
SET DR="10"
SET DIE="^DGM("
DO ^DIE
+5 IF '$ORDER(^DGM(DA,"M",0))
SET DIK=DIE
DO ^DIK
WRITE !,"MESSAGE DELETED"
GOTO PAT
+6 SET DGPGM="PR^DGPTMSG"
SET DGVAR="DGADMTY^DA"
SET ZTIO=DGMISD
SET DGUTQND=""
+7 DO Q1^DGUTQ
WRITE !!,"***** MESSAGE SENT *****",*7,!!
+8 GOTO PAT
PR ;
+1 USE IO
SET RET=""
SET L=$SELECT($DATA(^DGM(+DA,0)):^(0),1:0)
if 'L
GOTO Q
SET DFN=$PIECE(L,"^",2)
SET L1=$SELECT($DATA(^DPT(+DFN,0)):^(0),1:"")
SET X="N"
SET %DT="T"
DO ^%DT
SET NOW=Y
WRITE !!," Mess #: ",+L,?20,"Name: ",$EXTRACT($PIECE(L1,"^",1),1,27),?55," SSN: ",$PIECE(L1,"^",9),!
+2 SET D=$PIECE(L,"^",4)
WRITE "Entered: "
if D
WRITE $TRANSLATE($$FMTE^XLFDT(D,"5DF")," ","0")
WRITE ?22,"By: ",$SELECT($DATA(^VA(200,+$PIECE(L,"^",3),0)):$PIECE(^(0),U,1),1:""),?55,"Ward: ",$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"")
+3 WRITE !," Time: "
if D#1
WRITE $EXTRACT(D,9,10),":",$EXTRACT(D_"0000",11,12)
WRITE ?51,"Room/bed: ",$SELECT($DATA(^DPT(DFN,.101)):^(.101),1:""),!
+4 WRITE "Printed: ",$TRANSLATE($$FMTE^XLFDT(NOW,"5DF")," ","0"),?20,"Time: ",$EXTRACT(NOW_"00000",9,10)_":"_$EXTRACT(NOW_"00000",11,12)
+5 WRITE ?41,"Treating Specialty: ",$SELECT($DATA(^DPT(DFN,.103)):$SELECT($DATA(^DIC(45.7,+^(.103),0)):$PIECE(^(0),U,1),1:""),1:""),!
+6 IF DGADMTY]""
WRITE "Admission Type: ",$SELECT($DATA(^DG(405.1,+DGADMTY,0)):$PIECE(^(0),"^",1),1:"NOT SPECIFIED")
+7 WRITE ?51,"Provider: ",$SELECT($DATA(^DPT(DFN,.104)):$SELECT($DATA(^VA(200,+^(.104),0)):$PIECE(^(0),U,1),1:""),1:""),!
+8 SET DIC="^DGM("
SET DR="M"
KILL ^UTILITY($JOB)
DO EN^DIQ
+9 SET DR="4///NOW"
SET DIE="^DGM("
SET DP=45.5
DO ^DIE
+10 IF RET
SET DIE="^DGM("
SET DR="4///NOW;5///P"
SET DP=45.5
DO ^DIE
+11 if $ORDER(^DGM(DA,"E",0))'>0
GOTO QQ
WRITE !,"Edited",?17,"Retran",?25,"By",!
FOR I=1:1:60
WRITE "="
+12 FOR I=0:0
SET I=$ORDER(^DGM(DA,"E",I))
if I'>0
QUIT
SET L=^(I,0)
SET D=+L
WRITE !,$TRANSLATE($$FMTE^XLFDT(D,"5DF")," ","0"),"@",$EXTRACT(D_"0000",9,10),":",$EXTRACT(D_"00000",11,12),?17,$SELECT($PIECE(L,"^",3):"YES",1:"NO"),?25,$SELECT($DATA(^VA(200,+$PIECE(L,"^",2),0)):$PIECE(^(0),U,1),1:"")
QQ if IO]""
DO ^%ZISC
QUIT
+1 ;
IN SET DIC="^DGM("
SET DIC(0)="AEQMZ"
PA DO ^DIC
KILL DIC("S")
if Y'>0
GOTO Q
SET DA=+Y
+1 SET L=^DGM(DA,0)
SET DFN=$PIECE(L,"^",2)
SET L1=^DPT(DFN,0)
SET NOW=$PIECE(L,U,5)
WRITE !!," Mess #: ",+L,?20,"Name: ",$EXTRACT($PIECE(L1,"^",1),1,27),?55," SSN: ",$PIECE(L1,"^",9),!
+2 SET D=$PIECE(L,"^",4)
WRITE "Entered: ",$TRANSLATE($$FMTE^XLFDT(D,"5DF")," ","0"),?22,"By: ",$SELECT($DATA(^VA(200,+$PIECE(L,"^",3),0)):$PIECE(^(0),U,1),1:""),?55,"Ward: ",$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"")
+3 WRITE !," Time: ",$EXTRACT(D,9,10),":",$EXTRACT(D_"0000",11,12),?51,"Room/bed: ",$SELECT($DATA(^DPT(DFN,.101)):^(.101),1:""),!
+4 WRITE "Printed: "
if NOW
WRITE $TRANSLATE($$FMTE^XLFDT(NOW,"5DF")," ","0")
WRITE ?22,"Time: "
if NOW
WRITE $EXTRACT(NOW_"00000",9,10)_":"_$EXTRACT(NOW_"00000",11,12)
WRITE !
+5 if +$PIECE(L,U,7)'>0
GOTO M
SET N=$PIECE(L,U,7)_"00000"
WRITE "Chk off: ",$TRANSLATE($$FMTE^XLFDT(N,"5DF")," ","0"),?22,"Time: ",$EXTRACT(N,9,10)_":"_$EXTRACT(N,11,12),?53,"By: ",$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(L,U,8),0)):$PIECE(^(0),U,1),1:""),1,22),!
M SET DIC="^DGM("
SET DR="M"
DO EN^DIQ
+1 if $ORDER(^DGM(DA,"E",0))'>0
GOTO PA
WRITE !,"Edited",?17,"Retran",?25,"By",!
FOR I=1:1:60
WRITE "="
+2 FOR I=0:0
SET I=$ORDER(^DGM(DA,"E",I))
if I'>0
QUIT
SET L=^(I,0)
SET D=+L
WRITE !,$TRANSLATE($$FMTE^XLFDT(D,"5DF")," ","0"),"@",$EXTRACT(D_"0000",9,10),":",$EXTRACT(D_"00000",11,12),?17,$SELECT($PIECE(L,"^",3):"YES",1:"NO"),?25,$SELECT($DATA(^VA(200,+$PIECE(L,"^",2),0)):$PIECE(^(0),U,1),1:"")
+3 WRITE !!
GOTO PA
+4 ;
Q KILL DGADMTY,DGMISD,DGPGM,DGUTQND,DGVAR,%DT,D,DA,DIC,DIE,DIK,DP,DR,I,L,L1,N,NOW,RET,X,Y,ZTIO
QUIT
