- DGPTMSG ;ALB/JDS/AS - PTF MESSAGE ENTRY/EDIT/PRINT ; 7 NOV 89 14:46
- ;;5.3;Registration;**164,1015**;Aug 13, 1993;Build 21
- ;
- 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
- DGPTMSG ;ALB/JDS/AS - PTF MESSAGE ENTRY/EDIT/PRINT ; 7 NOV 89 14:46
- +1 ;;5.3;Registration;**164,1015**;Aug 13, 1993;Build 21
- +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
