source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVLB.m@ 1520

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1PSIVLB ;BIR/MV - DISPLAY PRINTED LABELS FOR AN ORDER ;30 Aug 2001 4:21 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**58,81**;16 DEC 97
3 ;
4 ; Reference to ^PS(52.6 is supported by DBIA 1231.
5 ; Reference to ^PS(52.7 is supported by DBIA 2173.
6 ; Reference to ^PS(55 is supported by DBIA 2191.
7 ;
8EN(DFN,ON,PSJALB,MORE) ;
9 ;DFN : Patient IEN
10 ;ON : IV ien#_"V"
11 ;PSJALB: 0 = including all labels
12 ; 1 = Consider active if:
13 ; NOT Reprinted/Recycled/Cancelled/Destroyed
14 ; NOT Given/Completed in BCMA
15 ; 2 = All condition in 1 but include Reprinted as active
16 ; (use for return/destroy)
17 ;MORE : 1 = Display extra info for the label
18 ;
19 ;This entry point is being from Protocal: PSJ PC IV LABELS ACTION
20 ;
21 ;* Quit if only display active labels and order is not active
22 ;I PSJALB,$S(P(17)="D":1,P(17)="E":1,P(17)="N":1,1:0) Q
23 ;
24 K ^TMP("PSIVLB",$J),PSJIDLST
25 S PSJLN=1 ;PSJLN is incrementting in SETTMP^PSJLMPRU
26 S PSJL=""
27 S PSIVLBNM="PSIVLB" D PIV^PSJLMPRI(DFN,ON,"","") K PSIVLBNM
28 D SETTMP^PSJLMPRU("PSIVLB"," ") S PSJL=""
29 S PSJL="------------------------ Labels available for "_$S(PSJALB=2:"return",1:"reprint")_" -------------------------"
30 D SETTMP^PSJLMPRU("PSIVLB",PSJL) S PSJL=""
31 F PSJLBN=0:0 S PSJLBN=$O(^PS(55,DFN,"IV",+ON,"BCMA",PSJLBN)) Q:'PSJLBN D
32 . NEW X,XX S XX=$G(^PS(55,DFN,"IVBCMA",PSJLBN,0)) Q:XX=""
33 . F X=1:1:8 S PSJLB(X)=$P(XX,U,X)
34 . I PSJALB=1,$S(PSJLB(7)]"":1,PSJLB(4)]""&("CG"[PSJLB(4)):1,1:0) Q
35 . I PSJALB=2,$S(PSJLB(4)]""&("CGIS"[PSJLB(4)):1,PSJLB(7)="RP":0,PSJLB(7)]"":1,1:0) Q
36 . S (PSJCNT,PSJIDLST)=$G(PSJCNT)+1
37 . S PSJL=$J(PSJCNT,3)_". "_PSJLB(1),PSJLEN=$L(PSJL)+5
38 . S PSJIDLST(PSJCNT)=PSJLB(1)
39 . S PSJIDLST(PSJLB(1))=PSJLB(1)
40 . F PSJAS="AD","SOL" D ADSOL(PSJAS)
41 . S X=$S(P(8)]"":P(8),1:P(9)),PSJL=$$SETSTR^VALM1(X,PSJL,PSJLEN,$L(X))
42 . D SETTMP^PSJLMPRU("PSIVLB",PSJL) S PSJL=""
43 . S X=PSJLB(4) I X]"" D
44 .. S X=" BCMA Status: "_$$CODES^PSIVUTL(X,55.0105,2)
45 .. S X=X_" "_$$ENDTC^PSGMI(PSJLB(3))
46 . S X=PSJLB(8)_X
47 . S PSJL=$$SETSTR^VALM1(X,PSJL,PSJLEN,$L(X))
48 . D SETTMP^PSJLMPRU("PSIVLB",PSJL) S PSJL=""
49 . D:+$G(MORE) MORE
50 S VALMCNT=PSJLN-1
51 K PSJCNT,PSJLB,PSJLBN,PSJLEN
52 Q
53ADSOL(PSJAS) ;
54 F PSJADSOL=0:0 S PSJADSOL=$O(^PS(55,DFN,"IVBCMA",PSJLBN,PSJAS,PSJADSOL)) Q:'PSJADSOL D
55 . NEW X,XX,PSJLB S XX=^PS(55,DFN,"IVBCMA",PSJLBN,PSJAS,PSJADSOL,0)
56 . F X=1:1:3 S PSJLB(X)=$P(XX,U,X)
57 . S X=$S(PSJAS="AD":52.6,1:52.7)
58 . S X=$P($G(^PS(X,+PSJLB(1),0)),U)
59 . S X=X_" "_PSJLB(2)_$S(PSJLB(3)]"":" ("_PSJLB(3)_")",1:"")
60 . S PSJL=$$SETSTR^VALM1(X,PSJL,PSJLEN,$L(X))
61 . D SETTMP^PSJLMPRU("PSIVLB",PSJL)
62 . S PSJL=""
63 Q
64MORE ;Display extra data for the label
65 D SETTMP^PSJLMPRU("PSIVLB","HELLO") S PSJL=""
66 Q
Note: See TracBrowser for help on using the repository browser.