source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTMSG.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1DGPTMSG ;ALB/JDS/AS - PTF MESSAGE ENTRY/EDIT/PRINT ; 7 NOV 89 14:46
2 ;;5.3;Registration;**164**;Aug 13, 1993
3 ;
4 D LO^DGUTL
5PAT K DIC("S") S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y,(DGMISD,DGADMTY)=""
6 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:"")
7 I DGMISD="" S DGMISD=$P(^DG(43,1,0),"^",19) G Q:DGMISD=""
8 K DGMSG D DICN1^DGPTMSG1 G Q:Y<0
9 S DA=+Y,DR="10",DIE="^DGM(" D ^DIE
10 I '$O(^DGM(DA,"M",0)) S DIK=DIE D ^DIK W !,"MESSAGE DELETED" G PAT
11 S DGPGM="PR^DGPTMSG",DGVAR="DGADMTY^DA",ZTIO=DGMISD,DGUTQND=""
12 D Q1^DGUTQ W !!,"***** MESSAGE SENT *****",*7,!!
13 G PAT
14PR ;
15 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),!
16 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:"")
17 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:""),!
18 W "Printed: ",$TR($$FMTE^XLFDT(NOW,"5DF")," ","0"),?20,"Time: ",$E(NOW_"00000",9,10)_":"_$E(NOW_"00000",11,12)
19 W ?41,"Treating Specialty: ",$S($D(^DPT(DFN,.103)):$S($D(^DIC(45.7,+^(.103),0)):$P(^(0),U,1),1:""),1:""),!
20 I DGADMTY]"" W "Admission Type: ",$S($D(^DG(405.1,+DGADMTY,0)):$P(^(0),"^",1),1:"NOT SPECIFIED")
21 W ?51,"Provider: ",$S($D(^DPT(DFN,.104)):$S($D(^VA(200,+^(.104),0)):$P(^(0),U,1),1:""),1:""),!
22 S DIC="^DGM(",DR="M" K ^UTILITY($J) D EN^DIQ
23 S DR="4///NOW",DIE="^DGM(",DP=45.5 D ^DIE
24 I RET S DIE="^DGM(",DR="4///NOW;5///P",DP=45.5 D ^DIE
25 G QQ:$O(^DGM(DA,"E",0))'>0 W !,"Edited",?17,"Retran",?25,"By",! F I=1:1:60 W "="
26 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:"")
27QQ D:IO]"" ^%ZISC Q
28 ;
29IN S DIC="^DGM(",DIC(0)="AEQMZ"
30PA D ^DIC K DIC("S") G Q:Y'>0 S DA=+Y
31 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),!
32 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:"")
33 W !," Time: ",$E(D,9,10),":",$E(D_"0000",11,12),?51,"Room/bed: ",$S($D(^DPT(DFN,.101)):^(.101),1:""),!
34 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 !
35 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),!
36M S DIC="^DGM(",DR="M" D EN^DIQ
37 G PA:$O(^DGM(DA,"E",0))'>0 W !,"Edited",?17,"Retran",?25,"By",! F I=1:1:60 W "="
38 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:"")
39 W !! G PA
40 ;
41Q K DGADMTY,DGMISD,DGPGM,DGUTQND,DGVAR,%DT,D,DA,DIC,DIE,DIK,DP,DR,I,L,L1,N,NOW,RET,X,Y,ZTIO Q
Note: See TracBrowser for help on using the repository browser.