source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOLET2.m@ 623

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1RMPOLET2 ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
2 ;;3.0;PROSTHETICS;**29,55**;Feb 09, 1996
3 ;
4 ; ODJ - patch 55 - 1/30/01 - replace hard code 121 mail symbol with
5 ; site param. extrinsic (AUG-1097-32118)
6 ;
7START ;
8 N HEAD,REC,POS
9 ;
10 K ^TMP($J)
11 Q:'$$SITE^RMPOLET0
12 ;
13 D GENOLST^RMPOLET0(1) ;generate list of patient to print
14 ;
15 I '$D(^TMP($J)) D G EXIT
16 . W !!,"There are no letters to print for this site."
17 . W !!,"Use the 'List of Patients' option to create a list.",!!,$C(7)
18 ;
19 Q:'$$LOCK^RMPOLET0("work with current")
20 ;
21 F D ASKHEAD Q:%'=0
22 S HEAD=% W @IOF
23 S %ZIS="Q" D ^%ZIS Q:$G(POP)=1
24 I $D(IO("Q")) D Q:'$$QUEUE^RMPOLET1(ZTDESC,ZTRTN,.ZTSAVE) D HOME^%ZIS Q
25 . K ZTSAVE
26 . S ZTDESC="RMPO : Patient Letter Print"
27 . S ZTRTN="PRINT^RMPOLET2("_HEAD_")"
28 . S (ZTSAVE("RMPOXITE"),ZTSAVE("RMPOSITE"),ZTSAVE("RMPO("),ZTSAVE("^TMP($J,"))=""
29 D PRINT(HEAD),EXIT
30 Q
31ASKHEAD ;
32 S %=1 W !,"Would you like a letterhead printed on the letters"
33 D YN^DICN
34 Q:%<0
35 I %=0 W !,"Answer 'Yes' for a header, 'No' for no header."
36 Q
37 ;
38PRINT(HEAD) ; Print H.O. correspondence
39 N DATE
40 ;
41 U IO(0) S Y=DT X ^DD("DD") S DATE=Y D:HEAD=1 HEADER
42 ;
43 S RMPOLCD="" F S RMPOLCD=$O(^TMP($J,"RMPOLST",RMPOLCD)) Q:RMPOLCD="" D
44 . S RMPODFN="" F S RMPODFN=$O(^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)) Q:RMPODFN="" D
45 . . S RMPOLTR=^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)
46 . . S REC=^TMP($J,"RMPODEMO",RMPODFN) D BODY
47 ;
48 Q
49BODY ; Set up array for filing and print letter
50 N I,LN,LNCT,SP,Y,NAME,SURNM,FRSTNM
51 ;
52 S $P(SP," ",80)=" ",LNCT=0
53 I HEAD'=1 F I=1:1:5 D LINE("")
54 E D
55 . F I=1:1:5 D LINE("")
56 . D LINE($E(SP,1,POS(1))_HEAD(1)),LINE($E(SP,1,POS(2))_HEAD(2))
57 . D LINE($E(SP,1,POS(3))_HEAD(3)),LINE($E(SP,1,POS(4))_HEAD(4))
58 . F I=1:1:4 D LINE("")
59 D LINE(DATE),LINE("")
60 S NAME=$P(REC,U),SURNM=$P(NAME,",",2),FRSTNM=$P(NAME,",")
61 S LN=$E(FRSTNM_" "_SURNM_SP,1,40)_"In Reply Refer To: "_RMPO("NAME")_"/"_$$ROU^RMPRUTIL(RMPOXITE)
62 D LINE(LN)
63 S LN=$P(REC,U,10),LN=$E(LN_SP,1,40)_"SSN: "_$P(REC,U,2)
64 D LINE(LN)
65 S LN=$P(REC,U,11) I LN]"" S LN=$E(LN_SP,1,40) D LINE(LN)
66 I $P(REC,U,12)]"" D LINE($P(REC,U,12))
67 ;
68 ; City, State, Zip
69 D LINE($P(REC,U,13)_", "_$P(REC,U,14)_" "_$P(REC,U,15))
70 ;I $P(REC,U,11)="",$P(REC,U,12)="" D LINE($E(SP,1,40)_$P(RMPODFN,U))
71 S RMPORX=$P(REC,U,6) S:RMPORX="" RMPORX="Not on file"
72 D LINE($E(SP,1,40)_FRSTNM_" "_SURNM)
73 D LINE($E(SP,1,40)_"Current Home Oxygen Rx#: "_RMPORX)
74 S LN=$E(SP,1,40)_"Rx Expiration Date: "
75 S RMPORXDT=$P(REC,U,4)
76 I RMPORXDT="" S RMPORXDT="n/a"
77 E S Y=RMPORXDT X ^DD("DD") S RMPORXDT=Y
78 D LINE(LN_RMPORXDT),LINE("")
79 D LINE("Dear "_$S($P(REC,U,9)="F":"Ms. ",1:"Mr. ")_SURNM_":")
80 D LINE(""),LINE("")
81 ;
82 ; print letter template
83 S I=0 F S I=$O(^RMPR(665.2,RMPOLTR,1,I)) Q:'I D LINE(^(I,0))
84 ;
85 ; Update Correspondence Tracking
86 ; DO NOT remove patient from list is correspondence update unsuccessful.
87 S X=$$FILE^RMPOLETU(RMPODFN,"^TMP($J,""LINE"")",LNCT,RMPOLTR)
88 I 'X W !,"<<< Error"_+X_":"_$P(X,";",2)_" Patient #"_RMPODFN_" ! >>>",*7 Q
89 ;
90 D UPDLTR^RMPOLET0(RMPODFN,"@") ; Clear "letter to be sent" field in RMPR(665
91 ;
92 I IOST["C-" R !!,"Press <ENTER> to continue",ANS:DTIME Q:'$T
93 Q
94 ;
95LINE(X) S LNCT=LNCT+1,^TMP($J,"LINE",LNCT,0)=" "_X
96 W !,?9,X
97 Q
98 ;
99HEADER ;
100 S HEAD(1)="Department of Veterans Affairs",POS(1)=45-($L(HEAD(1))\2)
101 S HEAD(2)=RMPO("NAME"),POS(2)=45-($L(HEAD(2))\2) ;name of VAMC
102 S HEAD(3)=RMPO("ADD"),POS(3)=45-($L(HEAD(3))\2) ;street address of VAMC
103 S HEAD(4)=RMPO("CITY"),POS(4)=45-($L(HEAD(4))\2) ;city,state and zip of VAMC
104 Q
105 ;
106EXIT ;Clean up and quit
107 ;
108 ;Close printer
109 D ^%ZISC
110 ;
111 ; clear lock of virtual control record
112 L -^TMP("RMPO",$J,"LETTERPRINT")
113 ;
114 ;Kill off variables
115 K ^TMP($J),%ZIS,Y,ZTSAVE,ZTRTN,RMPO,ZTDESC,L,LET
116 Q
Note: See TracBrowser for help on using the repository browser.