source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGMAR1.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1PSGMAR1 ;BIR/CML3-SORT ORDERS FOR 24 HOUR MAR ;22 JUL 96 / 7:06 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**8,111,145**;16 DEC 97;Build 17
3 ;
4 ;
5SP ; start print
6 U IO S (LN1,LN2,PSGOP,PN,RB,WDN,TM)="",PSGLSTOP=1,$P(LN1,"-",133)="",$P(LN2,"-",126)=""
7 K BLN S BLN(1)=$E(LN1,1,20),BLN(2)=" Indicate RIGHT (R)",BLN(3)=" or LEFT (L)",BLN(4)=" 1. DELTOID",BLN(5)=" 2. ABDOMEN",BLN(6)=" 3. ILIAC CREST",BLN(7)=" 4. GLUTEAL",BLN(8)=" 5. THIGH",BLN(9)="PRN: E=Effective",BLN(10)=" N=Not Effective"
8 I PSGSS="P"!(PSGSS="C")!(PSGSS="L") F S PN=$O(^TMP($J,PN)) Q:PN="" D P
9 Q:(PSGSS="P")!(PSGSS="C")!(PSGSS="L")
10 F S (PTM,TM)=$O(^TMP($J,TM)) Q:TM="" F S (PWDN,WDN)=$O(^TMP($J,TM,WDN)) Q:WDN="" D
11 . I PSGRBPPN="R" F S (PRB,RB)=$O(^TMP($J,TM,WDN,RB)) Q:RB="" F S PN=$O(^TMP($J,TM,WDN,RB,PN)) Q:PN="" S PPN=^(PN) D PI,^PSGMAR2
12 ;
13 ;DAM 5-01-07 - rewrite above lines to utilize the ^XTMP global set up in PSGMAR0 for printing by WARD/PATIENT or WARD GROUP
14 I PSGRBPPN="P" F S (PTM,TM)=$O(^XTMP(PSGREP,TM)) Q:TM="" F S PN=$O(^XTMP(PSGREP,TM,PN)) Q:PN="" D
15 . F S (PWDN,WDN)=$O(^XTMP(PSGREP,TM,PN,WDN)) Q:WDN="" D
16 . . F S (PRB,RB)=$O(^XTMP(PSGREP,TM,PN,WDN,RB)) Q:RB="" S PPN=^(RB) D PI,^PSGMAR2
17 Q
18 ;
19P ;
20 ;
21 N TMPPWDN
22 I PSGMARB=1 S PPN=^TMP($J,PN),PWDN=$S(PSGSS="C":$G(PSGAPWDN),1:$P(PPN,U,19)),PRB=$S(PSGSS="C":"",1:$P(PPN,U,20)),PTM="zz" D PI,^PSGMAR2 Q
23 S TMPPWDN=$P(^TMP($J,PN),U,19)
24 S:TMPPWDN="" TMPPWDN="zz"
25 S PWDN=""
26 F S PWDN=$O(^TMP($J,PN,PWDN)) Q:PWDN="" S TMPPWDN=PWDN S PPN=^TMP($J,PN),PRB=$P(PPN,U,20),PTM="zz" D PI,^PSGMAR2 S PWDN=TMPPWDN
27 Q
28 ;
29PI ; Parses patient information. Does not contain medication info.
30 K PSGMPG,PSGMPGN
31 S:PTM="zz" PTM="NOT FOUND" S:PWDN="zz" PWDN="NOT FOUND" S:PRB="zz" PRB="NOT FOUND"
32 S (PSGOP,PSGP)=+$P(PN,U,2),PSGP(0)=$P(PN,U),BD=$P(PPN,U,2),PSSN=$P(PPN,U,3),DX=$P(PPN,U,4),WT=$P(PPN,U,5)_" "_$P(PPN,U,6)
33 S HT=$P(PPN,U,7)_" "_$P(PPN,U,8),AD=$P(PPN,U,9),TD=$P(PPN,U,10),PSEX=$P(PPN,U,11),PSGLWD=$P(PPN,U,12)
34 S PSGPLS=$P(PPN,U,13),PSGPLF=$P(PPN,U,14),PSGMARSD=$P(PPN,U,15),PSGMARFD=$P(PPN,U,16),PSGMARSP=$P(PPN,U,17),PSGMARFP=$P(PPN,U,18)
35 S PPN=$P(PPN,U),PAGE=$P(BD,";",2),BD=$P(BD,";"),DFN=PSGP
36 D ATS^PSJMUTL(115,117,1)
37 Q
Note: See TracBrowser for help on using the repository browser.