Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSIVLB

PSIVLB.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Reference to ^PS(52.6 is supported by DBIA 1231.
  1.  ; Reference to ^PS(52.7 is supported by DBIA 2173.
  1.  ; Reference to ^PS(55 is supported by DBIA 2191.
  1.  ;
  1. EN(DFN,ON,PSJALB,MORE) ;
  1.  ;DFN   : Patient IEN
  1.  ;ON    : IV ien#_"V" 
  1.  ;PSJALB: 0 = including all labels 
  1.  ;        1 = Consider active if: 
  1.  ;            NOT Reprinted/Recycled/Cancelled/Destroyed
  1.  ;            NOT Given/Completed in BCMA
  1.  ;        2 = All condition in 1 but include Reprinted as active
  1.  ;            (use for return/destroy)
  1.  ;MORE  : 1 = Display extra info for the label
  1.  ;
  1.  ;This entry point is being from Protocal: PSJ PC IV LABELS ACTION
  1.  ;
  1.  ;* Quit if only display active labels and order is not active
  1.  ;I PSJALB,$S(P(17)="D":1,P(17)="E":1,P(17)="N":1,1:0) Q
  1.  ;
  1.  K ^TMP("PSIVLB",$J),PSJIDLST
  1.  S PSJLN=1 ;PSJLN is incrementting in SETTMP^PSJLMPRU
  1.  S PSJL=""
  1.  S PSIVLBNM="PSIVLB" D PIV^PSJLMPRI(DFN,ON,"","") K PSIVLBNM
  1.  D SETTMP^PSJLMPRU("PSIVLB"," ") S PSJL=""
  1.  S PSJL="------------------------ Labels available for "_$S(PSJALB=2:"return",1:"reprint")_" -------------------------"
  1.  D SETTMP^PSJLMPRU("PSIVLB",PSJL) S PSJL=""
  1.  F PSJLBN=0:0 S PSJLBN=$O(^PS(55,DFN,"IV",+ON,"BCMA",PSJLBN)) Q:'PSJLBN  D
  1.  . NEW X,XX S XX=$G(^PS(55,DFN,"IVBCMA",PSJLBN,0)) Q:XX=""
  1.  . F X=1:1:8 S PSJLB(X)=$P(XX,U,X)
  1.  . I PSJALB=1,$S(PSJLB(7)]"":1,PSJLB(4)]""&("CG"[PSJLB(4)):1,1:0) Q
  1.  . I PSJALB=2,$S(PSJLB(4)]""&("CGIS"[PSJLB(4)):1,PSJLB(7)="RP":0,PSJLB(7)]"":1,1:0) Q
  1.  . S (PSJCNT,PSJIDLST)=$G(PSJCNT)+1
  1.  . S PSJL=$J(PSJCNT,3)_". "_PSJLB(1),PSJLEN=$L(PSJL)+5
  1.  . S PSJIDLST(PSJCNT)=PSJLB(1)
  1.  . S PSJIDLST(PSJLB(1))=PSJLB(1)
  1.  . F PSJAS="AD","SOL" D ADSOL(PSJAS)
  1.  . S X=$S(P(8)]"":P(8),1:P(9)),PSJL=$$SETSTR^VALM1(X,PSJL,PSJLEN,$L(X))
  1.  . D SETTMP^PSJLMPRU("PSIVLB",PSJL) S PSJL=""
  1.  . S X=PSJLB(4) I X]"" D
  1.  .. S X="   BCMA Status: "_$$CODES^PSIVUTL(X,55.0105,2)
  1.  .. S X=X_" "_$$ENDTC^PSGMI(PSJLB(3))
  1.  . S X=PSJLB(8)_X
  1.  . S PSJL=$$SETSTR^VALM1(X,PSJL,PSJLEN,$L(X))
  1.  . D SETTMP^PSJLMPRU("PSIVLB",PSJL) S PSJL=""
  1.  . D:+$G(MORE) MORE
  1.  S VALMCNT=PSJLN-1
  1.  K PSJCNT,PSJLB,PSJLBN,PSJLEN
  1.  Q
  1. ADSOL(PSJAS) ;         
  1.  F PSJADSOL=0:0 S PSJADSOL=$O(^PS(55,DFN,"IVBCMA",PSJLBN,PSJAS,PSJADSOL)) Q:'PSJADSOL  D
  1.  . NEW X,XX,PSJLB S XX=^PS(55,DFN,"IVBCMA",PSJLBN,PSJAS,PSJADSOL,0)
  1.  . F X=1:1:3 S PSJLB(X)=$P(XX,U,X)
  1.  . S X=$S(PSJAS="AD":52.6,1:52.7)
  1.  . S X=$P($G(^PS(X,+PSJLB(1),0)),U)
  1.  . S X=X_" "_PSJLB(2)_$S(PSJLB(3)]"":" ("_PSJLB(3)_")",1:"")
  1.  . S PSJL=$$SETSTR^VALM1(X,PSJL,PSJLEN,$L(X))
  1.  . D SETTMP^PSJLMPRU("PSIVLB",PSJL)
  1.  . S PSJL=""
  1.  Q
  1. MORE ;Display extra data for the label
  1.  D SETTMP^PSJLMPRU("PSIVLB","HELLO") S PSJL=""
  1.  Q