source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJMIV.m@ 1520

PSJMIV ;BIR/MV-IV ORDER FOR MED DUE WORKSHEET.  ;20 DEC 96 / 3:12 PM
 ;;5.0; INPATIENT MEDICATIONS ;**58,116**;16 DEC 97
 ;
 ; Reference to ^PS(55 is supported by DBIA 2191.
 ;
START ;*** Read IV orders
 NEW P S ON=""
 F PSGEXPDT=PSGPLS-.0001:0 S PSGEXPDT=$O(^PS(55,PSGP,"IV","AIT",PST,PSGEXPDT)) Q:'PSGEXPDT  F  S ON=$O(^PS(55,PSGP,"IV","AIT",PST,PSGEXPDT,ON)) Q:ON=""  D IV
 Q
IV ;*** Process IV order based on schedule and interval
 K ADM N X,ON55,PSJLABEL S DFN=PSGP,PSJLABEL=1 D GT55^PSIVORFB
 Q:"DE"[P(17)
 Q:P(2)>PSGPLF
 S X=$P(P("MR"),U,2) Q:XTYPE=2&(X["IV")  Q:XTYPE=3&(PST="S")&'($S(X="IV":1,X="IVPB":1,1:0))
 S QST=$$ONE^PSJBCMA(PSGP,ON,P(9),P(2),P(3))
 S QST=$S(P(9)["PRN":"OVP",QST="O":"OVO",1:"CV")_XTYPE
 I P(9)]"" D SCHEDULE Q
 S PSGON=0 D:P(15) INTERVAL
 Q
INTERVAL ;*** Calculate admin time by schedule interval.
 NEW MN,ND,ND1,PLSD,PSGPLC,ST,T,TS
 K PSGMAR
 F I=0:1 S ADM=$$FMADD^XLFDT(P(2),0,0,P(15)*I,0) Q:ADM>$S(P(3)<PSGPLF:P(3),1:PSGPLF)  S:ADM'<PSGPLS PSGMAR(ADM)=""
 S ON=ON_"*" D IVTMP ;*** ON_"*" =projected time for cont. IV.
 Q
SCHEDULE ;*** Calculate admin times for IV that has schedule defined.
 K PSGMAR S PSGPLC=0 S PSGOES=1,X=P(9) D EN^PSGS0 S T=PSGS0XT,PSGOES=""
 S ND1=P(4),ST=P(2),PLSD=P(3),TS=P(11),MN=T,ND=P(9) I $S(ST'?7N1"."1N.E:1,1:PLSD'?7N1"."1N.E) S PSGPLC="OI" Q
 D ENIV^PSJPL0
 D IVTMP
 Q
IVTMP ;*** Set IV ^TMP.
 I DRG S X=$S($G(DRG("AD",1)):DRG("AD",1),1:$G(DRG("SOL",1))),DRG=$E($$ENPDN^PSGMI($P(X,U,6)),1,20)_U_ON
 F ADMIN=0:0 S ADMIN=$O(PSGMAR(ADMIN)) Q:'ADMIN  S PSJADT=$P(ADMIN,"."),PSJATME=+$E($P(ADMIN,".",2)_"0000",1,4) D @PSGSS
 Q
P ;*** Set ^TMP when select by patient
 S ^TMP($J,PSJADT,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSJPWDN_U_PSJPRB
 Q
G ;*** Goto W to set ^TMP when selected by WARD/WARD GROUP
 ;
W ;
 S:PSGRBADM="A" ^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
 S:PSGRBADM="R" ^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
 S:PSGRBADM="P" ^TMP($J,PSJADT,TM,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
 Q
 ;
 ;
PRT ;*** Print IV orders for Med Due Worksheet.
 N ON55,DRG,P,PSJLABEL S DFN=PSGP,PSJLABEL=1
 D:QST'["Z" GT55^PSIVORFB
 ;* I QST["Z" D GT531^PSIVORFA(DFN,ON) S P("OPI")=^TMP($J,QST,PSGP,ON,1)
 I QST["Z" D GT531^PSIVORFA(DFN,ON),SI^PSJMPEND S P("OPI")=PSJSI
 F X="LOG",2,3 S:P(X) P(X)=$$ENDTC^PSGMI(P(X))
 S PSJONETM=$S(QST="OVO":1,1:0)
 S PSJSI=$P(P("OPI"),"^")
 NEW NEED S PSJNEED=0
 F X="AD","SOL" D NAMENEED^PSJMUTL(X,40,.NEED) S PSJNEED=PSJNEED+NEED
 S X=$L($P(P("OPI"),"^"))/41,X=$P(X,".")+($P(X,".",2)>0)+(P(4)="C")
 S:$D(DRG("AD",0))&$D(DRG("SOL",0)) X=X+1
 S PSJNEED=PSJNEED+X+4+PSJONETM
 D ^PSJMPRTU
 D:(PSJNEED+PSJLN)>PSJTOTLN HDR^PSJMPRTU Q:$G(PSJSTOP)
 D PRTIV
 Q
 ;
PRTIV ;
 ;* W !,PSJPRT(1),?39,$E(P("LOG"),1,5)," | ",$E(P(2),1,5),$E(P(2),9,15)," | ",P(3)
 W !,PSJPRT(1),?39,$E(P("LOG"),1,5)," | "
 I QST["Z" W "P E N D I N G"
 E  W $E(P(2),1,5),$E(P(2),9,15)," | ",P(3)
 NEW X,Y
 F X=0:0 S X=$O(DRG("AD",X)) Q:'X  D NAME^PSIVUTL(DRG("AD",X),40,.NAME,1) F Y=0:0 S Y=$O(NAME(Y))  Q:'Y  D ADSOL W NAME(Y)
 I $G(DRG("SOL",1)) D ADSOL W " in"
 F X=0:0 S X=$O(DRG("SOL",X)) Q:'X  D NAME^PSIVUTL(DRG("SOL",X),40,.NAME,0) F Y=0:0 S Y=$O(NAME(Y))  Q:'Y  D ADSOL W NAME(Y)
 S:ON["*" PSJASTR=1
 W !?39,$P(P("MR"),U,2)," ",P(9)," ",P(8)
 W:PSJONETM !?39,"*** ONE TIME ***"
 W:P(4)="C" !?39,"*CAUTION-CHEMOTHERAPY*"
 I PSJSI]"" W !?39 F Y=1:1:$L(PSJSI," ") S Y1=$P(PSJSI," ",Y) W:($L(Y1)+$X)>79 !?39 W Y1_" "
 W !?39,"RN/LPN Init: ________"
 W !
 S PSJLN=PSJLN+PSJNEED
 Q
ADSOL ;
 I PSJLN>PSJTOTLN W !?39,"*** CONTINUE ON NEXT PAGE ***" NEW X D ^PSJMPRTU,HDR^PSJMPRTU D
 .W !,PSJPRT(1),?39,$E(P("LOG"),1,5)," | ",$E(P(2),1,5),$E(P(2),9,15)," | ",P(3)
 S PSJLN=PSJLN+1,PSJNEED=PSJNEED-1
 S I=$O(PSJPRT(1)) W !,$G(PSJPRT(+I)),?39
 K:I PSJPRT(I)
 Q