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