- PSIVPRO ;BIR/PR,MLM - PROFILE AN ORDER ;Jul 03, 2018@08:39
- ;;5.0;INPATIENT MEDICATIONS;**38,58,85,110,181,263,275,373**;16 DEC 97;Build 3
- ;33
- ; Reference to ^PS(55 is supported by DBIA 2191
- ;
- ;Needs DFN and ^TMP("PSIV",$J) array
- N PSJCLNSV
- S PSJLN=1,PSIVX2=0
- S PSIVST=$O(^TMP("PSIV",$J,0)),X="",(PSIVON,PS)=0 D REACT I PSIVST]"" F PSIVX1=1:1 D PSIVST Q:'PSIVON D PR
- S ^TMP("PSJPRO",$J,0)=PSIVX2,VALMCNT=PSJLN-1
- I $G(PSIVBR)="D ^PSIVOPT" S VALM("TITLE")="IV Order Entry"
- E S VALM("TITLE")="IV Profile"
- QUIT ; Kill and exit.
- S ON=X K ADM,AL,DRG,GMRA,GMRAL,PSIVST,PSIVX1,PSIVX2,Y,NAD,N0,X3,X4,X5
- Q
- ;
- PSIVST ;
- S PSIVON=$O(^TMP("PSIV",$J,PSIVST,PSIVON)) I 'PSIVON S PSIVST=$O(^TMP("PSIV",$J,PSIVST_"Z")) I PSIVST]"" S PSIVON=$O(^TMP("PSIV",$J,PSIVST,0)) D HDL
- Q
- REACT ;
- S PSJL="# Additive",PSJL=$$SETSTR^VALM1("Last fill",PSJL,32,9)
- ;S PSJL=$$SETSTR^VALM1("Type",PSJL,49,4),PSJL=$$SETSTR^VALM1(" Start Stop Stat",PSJL,54,19) ;#373
- S PSJL=$$SETSTR^VALM1("Type",PSJL,49,4),PSJL=$$SETSTR^VALM1(" Start Stop Stat",PSJL,54,26) ;#373
- ;S PSJL=$$SETSTR^VALM1("Renew",PSJL,74,5) ;#373
- D SETTMP^PSJLMPRI
- HDL ; Display type heading.
- S PSJL=""
- D ACL:($P(PSIVST,"^")'="Cz")&(PSIVST="A"),DPL:($P(PSIVST,"^")'="Cz")&(PSIVST="RD"),POL:($P(PSIVST,"^")'="Cz")&(PSIVST="P"),POCL:($P(PSIVST,"^")'="Cz")&(PSIVST="PD")
- D NVL:($P(PSIVST,"^")'="Cz")&(PSIVST="N"),NVCL:($P(PSIVST,"^")'="Cz")&(PSIVST="ND"),NOL:($P(PSIVST,"^")'="Cz")&(PSIVST="X")
- D NOC:($P(PSIVST,"^")'="Cz")&(PSIVST=""),CLIN($P(PSIVST,"^",2)):($P(PSIVST,"^")="Cz"&($P(PSIVST,"^",2)'=$G(PSJCLNSV))) S X=""
- I ($P(PSIVST,"^")="Cz") S PSJCLNSV=$P(PSIVST,"^",2)
- S PSJL=$E(PSJL,1,79) D SETTMP^PSJLMPRI
- Q
- ;
- PR ; Get & display order.
- I ($P(PSIVST,"^")'="Cz") S (ON,ON55)=9999999999-($S(PSIVST["P":$E(PSIVON,2,11),PSIVST["N":$E(PSIVON,2,11),1:PSIVON))_$S(PSIVST["P":"P",PSIVST["N":"P",1:"V") D
- .D @$S(PSIVST["P":"GT531^PSIVORFA(DFN,ON)",PSIVST["N":"GT531^PSIVORFA(DFN,ON)",1:"GT55^PSIVORFB")
- I ($P(PSIVST,"^")="Cz") S (ON,ON55)=9999999999-($S($P(PSIVST,"^",4)["P":$E(PSIVON,2,11),$P(PSIVST,"^",4)["N":$E(PSIVON,2,11),1:PSIVON))_$S($P(PSIVST,"^",4)["P":"P",$P(PSIVST,"^",4)["N":"P",1:"V") D
- .D @$S($P(PSIVST,"^",4)["P":"GT531^PSIVORFA(DFN,ON)",$P(PSIVST,"^",4)["N":"GT531^PSIVORFA(DFN,ON)",1:"GT55^PSIVORFB")
- S X="",PS=PSIVX1 K ^TMP("PSIV",$J,PSIVST,PSIVON) D
- .I ($P(PSIVST,"^")'="Cz") S ^TMP("PSIV",$J,PSIVST_"B",PSIVX1)=$S(PSIVST["P":$E(PSIVON,2,11),PSIVST["N":$E(PSIVON,2,11),1:PSIVON)_$S(PSIVST["P":"P",PSIVST["N":"P",1:"V")
- .I ($P(PSIVST,"^")="Cz") S ^TMP("PSIV",$J,PSIVST_"B",PSIVX1)=$S($P(PSIVST,"^",4)["P":$E(PSIVON,2,11),$P(PSIVST,"^",4)["N":$E(PSIVON,2,11),1:PSIVON)_$S($P(PSIVST,"^",4)["P":"P",$P(PSIVST,"^",4)["N":"P",1:"V")
- .I PSIVST="RD"!($P(PSIVST,"^",4)="RD") D ENPL Q
- I ($P(PSIVST,"^")'="Cz"),(PSIVST["D") N PSJO,PSIVX3 S PSIVX3=PSIVX1,PSJO=0 I $G(PSJCOM) D
- .F S PSJO=$O(^PS(53.1,"ACX",PSJCOM,PSJO)) Q:'PSJO S ON=PSJO_"P" D GT531^PSIVORFA(DFN,ON),ENPL S PSIVX1=""
- I ($P(PSIVST,"^")'="Cz"),(PSIVST["D") S PSIVX1=PSIVX3 Q
- ;
- ENPL ;
- NEW MARX,DRUGNAME,X,XX
- S PSJL=$J(PSIVX1,4) I ON["P",(P("OT")'="F"),P(4)'="H" D Q
- . I $D(VALMEVL) D
- .. N PSJFLAG
- .. S PSJFLAG=$P($S(ON["V":$G(^PS(55,DFN,"IV",+ON,.2)),1:$G(^PS(53.1,+ON,.2))),U,7)
- .. I PSJFLAG D CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
- . D DRGDISP^PSJLMUT1(DFN,ON,34,59,.DRUGNAME,0)
- . NEW X F X=0:0 S X=$O(DRUGNAME(X)) Q:'X S:X>1 PSJL="" S PSJL=$$SETSTR^VALM1(DRUGNAME(X),PSJL,$S(X=1:6,1:7),$S(X=1:34,1:65)) D:X=1 V D SETTMP^PSJLMPRI
- S X=$J(PSIVX1,4)_$S(P("PRY")="D":" d",1:" ")
- I ON["V" S XX=$G(^PS(55,DFN,"IV",+ON,4)) D
- . I +PSJSYSU=1,'+XX S X=X_"->"
- . I +PSJSYSU=3,'+$P(XX,U,4) S X=X_"->"
- S PSJL=X
- I $D(VALMEVL) D
- . N PSJFLAG
- . S PSJFLAG=$P($S(ON["V":$G(^PS(55,DFN,"IV",+ON,.2)),1:$G(^PS(53.1,+ON,.2))),U,7)
- . I PSJFLAG D CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
- NEW RNWPRTD S RNWPRTD=0 ;#373
- D AD,SOL
- I 'RNWPRTD D RENEWDT I PSJL["Renewed" D SETTMP^PSJLMPRI ;#373
- Q
- SOL ;
- NEW NAME,PSJNOAD,L ;S PSJNOAD=0,L=34
- S NAD=0 F S NAD=$O(DRG("SOL",NAD)) Q:'NAD D
- . K NAME S L=34,PSJNOAD=0
- . I '$D(DRG("AD",1)),NAD=1 S PSJNOAD=1,L=27
- . S:NAD=1 PSJL=$$SETSTR^VALM1("in",PSJL,6,11)
- . D NAME^PSIVUTL(DRG("SOL",NAD),L,.NAME,0)
- . F X=0:0 S X=$O(NAME(X)) Q:'X S:(NAD>1!(X>1)) PSJL="" S PSJL=$$SETSTR^VALM1(NAME(X),PSJL,9,34) D:X=1&PSJNOAD V D:(NAD>1!(X>1)) RENEWDT D SETTMP^PSJLMPRI ;#373 - Call to RENEWDT added
- . S PSJL=""
- Q
- AD ;
- NEW NAME
- S NAD=0 F S NAD=$O(DRG("AD",NAD)) Q:'NAD D
- . K NAME
- . ;D NAME^PSIVUTL(DRG("AD",NAD),30,.NAME,1)
- . D NAME^PSIVUTL(DRG("AD",NAD),27,.NAME,1)
- . F X=0:0 S X=$O(NAME(X)) Q:'X S:(NAD>1!(X>1)) PSJL="" S PSJL=$$SETSTR^VALM1(NAME(X),PSJL,6,34) D:(NAD=1&(X=1)) V D:(NAD>1!(X>1)) RENEWDT D SETTMP^PSJLMPRI ;#373 - Call to RENEWDT added
- . S PSJL=""
- Q
- ;
- V S Y=$S(ON["V":$P($G(^PS(55,DFN,"IV",+ON,9)),U),1:"")
- I +Y>0 X ^DD("DD") S Y=$P(Y,",")_" "_$P($P(Y,"@",2),":",1,2)
- E S Y="** N/P **"
- S PSJL=$$SETSTR^VALM1(Y,PSJL,33,12)
- S PSJL=$$SETSTR^VALM1(" #"_$S(ON["V":+$P($G(^PS(55,DFN,"IV",+ON,9)),U,2),1:0),PSJL,46,3)
- S:PSIVX1]"" PSIVX2=PSIVX2+1
- D REST
- Q
- ACL ;
- F X3=1:1:71 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" A c t i v e "
- Q
- NVL ;
- F X3=1:1:71 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" N o n - V e r i f i e d "
- Q
- NVCL ;
- F X3=1:1:71 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" N o n - V e r i f i e d C o m p l e x "
- Q
- POL ;
- F X3=1:1:71 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" P e n d i n g "
- Q
- POCL ;
- F X3=1:1:66 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" P e n d i n g C o m p l e x "
- Q
- NOL ;
- F X3=1:1:66 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" N o t A c t i v e "
- Q
- CLIN(CLINIC) ; Print Clinic Name section header
- N LEFTALIN S LEFTALIN=(80-$L(CLINIC))\2
- F X3=1:1:71 S PSJL=PSJL_"-" S:(X3=(LEFTALIN)) PSJL=PSJL_CLINIC
- Q
- DPL ;Recently dc/expired header
- S PSJDCEXP=$$RECDCEXP^PSJP()
- F X3=1:1:71 S PSJL=PSJL_"-" S:X3=15 PSJL=PSJL_"Recently Discontinued/Expired (Last "_+$G(PSJDCEXP)_" hours)"
- Q
- NOC ;
- F X3=1:1:66 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" No current IV information "
- ;
- S PSJL=""
- Q
- REST ;
- S PSJL=$$SETSTR^VALM1(P(4),PSJL,52,1)
- ;S PSJL=$$SETSTR^VALM1($E($$ENDTC^PSGMI(P(2)),1,5),PSJL,55,5) ;#373
- S PSJL=$$SETSTR^VALM1($E($$ENDTC2^PSGMI(P(2)),1,10),PSJL,55,10) ;#373
- ;S PSJL=$$SETSTR^VALM1($E($$ENDTC^PSGMI(P(3)),1,5),PSJL,62,5) ;#373
- S PSJL=$$SETSTR^VALM1($E($$ENDTC2^PSGMI(P(3)),1,10),PSJL,66,10) ;#373
- ;S PSJL=$$SETSTR^VALM1($S(P(17)="R"&(ON'["V"):"R/I",$G(P(25))]"":P(25),1:P(17)),PSJL,69,2) ;#373
- S PSJL=$$SETSTR^VALM1($S(P(17)="R"&(ON'["V"):"R/I",$G(P(25))]"":P(25),1:P(17)),PSJL,77,2) ;#373
- ;S PSJL=$$SETSTR^VALM1($S(ON["P":P("PRY"),1:""),PSJL,71,1) ;#373
- S PSJL=$$SETSTR^VALM1($S(ON["P":P("PRY"),1:""),PSJL,79,1) ;#373
- ;N PSJLRN S PSJLRN=$$LASTREN^PSJLMPRI(DFN,ON55) I PSJLRN S PSJLRN=$E($$ENDTC^PSGMI(PSJLRN),1,5) S PSJL=$$SETSTR^VALM1(PSJLRN,PSJL,74,5) ;#373
- Q
- RENEWDT ; 373 - Put renewal date on 2nd line instead of 1st.
- Q:RNWPRTD
- N PSJLRN S PSJLRN=$$LASTREN^PSJLMPRI(DFN,ON55)
- I PSJLRN D
- . S PSJLRN=$E($$ENDTC2^PSGMI(PSJLRN),1,10)
- . S PSJL=$$SETSTR^VALM1("Renewed:",PSJL,55,8)
- . S PSJL=$$SETSTR^VALM1(PSJLRN,PSJL,64,10),RNWPRTD=1
- Q
- XCHK ;
- I $E(X)="?" W !!?2,"Select order",$E("s",PS'=1)," (1" W:PS>1 "-",PS W ")."
- I $E(X)="?" W:$S($O(^TMP("PSIV",$J,PSIVST,ON)):1,1:$O(^TMP("PSIV",$J,PSIVST))]"") " Press RETURN to view more orders, or enter '^' to abort",!,"the profile, or 'A' to view Allergies." D:$E(X,1,2)="??" H2^PSGON K X Q
- S PSGLMT=PS D ^PSGON Q
- ;
- PSPD S Y=$S(PSIVST'="P":$P($G(^PS(55,DFN,"IV",+ON,9)),U),1:"")
- X ^DD("DD") S:Y="" PSJL=$$SETSTR^VALM1("** N/P **",PSJL,36,12)
- S:Y'="" PSJL=$$SETSTR^VALM1($P(Y,","),PSJL,36,7),PSJL=$$SETSTR^VALM1($P($P(Y,"@",2),":",1,2),PSJL,43,45)
- S PSJL=PSJL_" #"_$S(Y="":0,1:$P(^PS(55,DFN,"IV",+ON,9),U,2))
- D REST
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVPRO 7882 printed Feb 18, 2025@23:31:17 Page 2
- PSIVPRO ;BIR/PR,MLM - PROFILE AN ORDER ;Jul 03, 2018@08:39
- +1 ;;5.0;INPATIENT MEDICATIONS;**38,58,85,110,181,263,275,373**;16 DEC 97;Build 3
- +2 ;33
- +3 ; Reference to ^PS(55 is supported by DBIA 2191
- +4 ;
- +5 ;Needs DFN and ^TMP("PSIV",$J) array
- +6 NEW PSJCLNSV
- +7 SET PSJLN=1
- SET PSIVX2=0
- +8 SET PSIVST=$ORDER(^TMP("PSIV",$JOB,0))
- SET X=""
- SET (PSIVON,PS)=0
- DO REACT
- IF PSIVST]""
- FOR PSIVX1=1:1
- DO PSIVST
- if 'PSIVON
- QUIT
- DO PR
- +9 SET ^TMP("PSJPRO",$JOB,0)=PSIVX2
- SET VALMCNT=PSJLN-1
- +10 IF $GET(PSIVBR)="D ^PSIVOPT"
- SET VALM("TITLE")="IV Order Entry"
- +11 IF '$TEST
- SET VALM("TITLE")="IV Profile"
- QUIT ; Kill and exit.
- +1 SET ON=X
- KILL ADM,AL,DRG,GMRA,GMRAL,PSIVST,PSIVX1,PSIVX2,Y,NAD,N0,X3,X4,X5
- +2 QUIT
- +3 ;
- PSIVST ;
- +1 SET PSIVON=$ORDER(^TMP("PSIV",$JOB,PSIVST,PSIVON))
- IF 'PSIVON
- SET PSIVST=$ORDER(^TMP("PSIV",$JOB,PSIVST_"Z"))
- IF PSIVST]""
- SET PSIVON=$ORDER(^TMP("PSIV",$JOB,PSIVST,0))
- DO HDL
- +2 QUIT
- REACT ;
- +1 SET PSJL="# Additive"
- SET PSJL=$$SETSTR^VALM1("Last fill",PSJL,32,9)
- +2 ;S PSJL=$$SETSTR^VALM1("Type",PSJL,49,4),PSJL=$$SETSTR^VALM1(" Start Stop Stat",PSJL,54,19) ;#373
- +3 ;#373
- SET PSJL=$$SETSTR^VALM1("Type",PSJL,49,4)
- SET PSJL=$$SETSTR^VALM1(" Start Stop Stat",PSJL,54,26)
- +4 ;S PSJL=$$SETSTR^VALM1("Renew",PSJL,74,5) ;#373
- +5 DO SETTMP^PSJLMPRI
- HDL ; Display type heading.
- +1 SET PSJL=""
- +2 if ($PIECE(PSIVST,"^")'="Cz")&(PSIVST="A")
- DO ACL
- if ($PIECE(PSIVST,"^")'="Cz")&(PSIVST="RD")
- DO DPL
- if ($PIECE(PSIVST,"^")'="Cz")&(PSIVST="P")
- DO POL
- if ($PIECE(PSIVST,"^")'="Cz")&(PSIVST="PD")
- DO POCL
- +3 if ($PIECE(PSIVST,"^")'="Cz")&(PSIVST="N")
- DO NVL
- if ($PIECE(PSIVST,"^")'="Cz")&(PSIVST="ND")
- DO NVCL
- if ($PIECE(PSIVST,"^")'="Cz")&(PSIVST="X")
- DO NOL
- +4 if ($PIECE(PSIVST,"^")'="Cz")&(PSIVST="")
- DO NOC
- if ($PIECE(PSIVST,"^")="Cz"&($PIECE(PSIVST,"^",2)'=$GET(PSJCLNSV)))
- DO CLIN($PIECE(PSIVST,"^",2))
- SET X=""
- +5 IF ($PIECE(PSIVST,"^")="Cz")
- SET PSJCLNSV=$PIECE(PSIVST,"^",2)
- +6 SET PSJL=$EXTRACT(PSJL,1,79)
- DO SETTMP^PSJLMPRI
- +7 QUIT
- +8 ;
- PR ; Get & display order.
- +1 IF ($PIECE(PSIVST,"^")'="Cz")
- SET (ON,ON55)=9999999999-($SELECT(PSIVST["P":$EXTRACT(PSIVON,2,11),PSIVST["N":$EXTRACT(PSIVON,2,11),1:PSIVON))_$SELECT(PSIVST["P":"P",PSIVST["N":"P",1:"V")
- Begin DoDot:1
- +2 DO @$SELECT(PSIVST["P":"GT531^PSIVORFA(DFN,ON)",PSIVST["N":"GT531^PSIVORFA(DFN,ON)",1:"GT55^PSIVORFB")
- End DoDot:1
- +3 IF ($PIECE(PSIVST,"^")="Cz")
- SET (ON,ON55)=9999999999-($SELECT($PIECE(PSIVST,"^",4)["P":$EXTRACT(PSIVON,2,11),$PIECE(PSIVST,"^",4)["N":$EXTRACT(PSIVON,2,11),1:PSIVON))_$SELECT($PIECE(PSIVST,"^",4)["P":"P",$PIECE(PSIVST,"^",4)["N":"P",1:"V")
- Begin DoDot:1
- +4 DO @$SELECT($PIECE(PSIVST,"^",4)["P":"GT531^PSIVORFA(DFN,ON)",$PIECE(PSIVST,"^",4)["N":"GT531^PSIVORFA(DFN,ON)",1:"GT55^PSIVORFB")
- End DoDot:1
- +5 SET X=""
- SET PS=PSIVX1
- KILL ^TMP("PSIV",$JOB,PSIVST,PSIVON)
- Begin DoDot:1
- +6 IF ($PIECE(PSIVST,"^")'="Cz")
- SET ^TMP("PSIV",$JOB,PSIVST_"B",PSIVX1)=$SELECT(PSIVST["P":$EXTRACT(PSIVON,2,11),PSIVST["N":$EXTRACT(PSIVON,2,11),1:PSIVON)_$SELECT(PSIVST["P":"P",PSIVST["N":"P",1:"V")
- +7 IF ($PIECE(PSIVST,"^")="Cz")
- SET ^TMP("PSIV",$JOB,PSIVST_"B",PSIVX1)=$SELECT($PIECE(PSIVST,"^",4)["P":$EXTRACT(PSIVON,2,11),$PIECE(PSIVST,"^",4)["N":$EXTRACT(PSIVON,2,11),1:PSIVON)_$SELECT($PIECE(PSIVST,"^",4)["P":"P",$PIECE(PSIVST,"^",4)["N":"P",1:"V")
- +8 IF PSIVST="RD"!($PIECE(PSIVST,"^",4)="RD")
- DO ENPL
- QUIT
- End DoDot:1
- +9 IF ($PIECE(PSIVST,"^")'="Cz")
- IF (PSIVST["D")
- NEW PSJO,PSIVX3
- SET PSIVX3=PSIVX1
- SET PSJO=0
- IF $GET(PSJCOM)
- Begin DoDot:1
- +10 FOR
- SET PSJO=$ORDER(^PS(53.1,"ACX",PSJCOM,PSJO))
- if 'PSJO
- QUIT
- SET ON=PSJO_"P"
- DO GT531^PSIVORFA(DFN,ON)
- DO ENPL
- SET PSIVX1=""
- End DoDot:1
- +11 IF ($PIECE(PSIVST,"^")'="Cz")
- IF (PSIVST["D")
- SET PSIVX1=PSIVX3
- QUIT
- +12 ;
- ENPL ;
- +1 NEW MARX,DRUGNAME,X,XX
- +2 SET PSJL=$JUSTIFY(PSIVX1,4)
- IF ON["P"
- IF (P("OT")'="F")
- IF P(4)'="H"
- Begin DoDot:1
- +3 IF $DATA(VALMEVL)
- Begin DoDot:2
- +4 NEW PSJFLAG
- +5 SET PSJFLAG=$PIECE($SELECT(ON["V":$GET(^PS(55,DFN,"IV",+ON,.2)),1:$GET(^PS(53.1,+ON,.2))),U,7)
- +6 IF PSJFLAG
- DO CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
- End DoDot:2
- +7 DO DRGDISP^PSJLMUT1(DFN,ON,34,59,.DRUGNAME,0)
- +8 NEW X
- FOR X=0:0
- SET X=$ORDER(DRUGNAME(X))
- if 'X
- QUIT
- if X>1
- SET PSJL=""
- SET PSJL=$$SETSTR^VALM1(DRUGNAME(X),PSJL,$SELECT(X=1:6,1:7),$SELECT(X=1:34,1:65))
- if X=1
- DO V
- DO SETTMP^PSJLMPRI
- End DoDot:1
- QUIT
- +9 SET X=$JUSTIFY(PSIVX1,4)_$SELECT(P("PRY")="D":" d",1:" ")
- +10 IF ON["V"
- SET XX=$GET(^PS(55,DFN,"IV",+ON,4))
- Begin DoDot:1
- +11 IF +PSJSYSU=1
- IF '+XX
- SET X=X_"->"
- +12 IF +PSJSYSU=3
- IF '+$PIECE(XX,U,4)
- SET X=X_"->"
- End DoDot:1
- +13 SET PSJL=X
- +14 IF $DATA(VALMEVL)
- Begin DoDot:1
- +15 NEW PSJFLAG
- +16 SET PSJFLAG=$PIECE($SELECT(ON["V":$GET(^PS(55,DFN,"IV",+ON,.2)),1:$GET(^PS(53.1,+ON,.2))),U,7)
- +17 IF PSJFLAG
- DO CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
- End DoDot:1
- +18 ;#373
- NEW RNWPRTD
- SET RNWPRTD=0
- +19 DO AD
- DO SOL
- +20 ;#373
- IF 'RNWPRTD
- DO RENEWDT
- IF PSJL["Renewed"
- DO SETTMP^PSJLMPRI
- +21 QUIT
- SOL ;
- +1 ;S PSJNOAD=0,L=34
- NEW NAME,PSJNOAD,L
- +2 SET NAD=0
- FOR
- SET NAD=$ORDER(DRG("SOL",NAD))
- if 'NAD
- QUIT
- Begin DoDot:1
- +3 KILL NAME
- SET L=34
- SET PSJNOAD=0
- +4 IF '$DATA(DRG("AD",1))
- IF NAD=1
- SET PSJNOAD=1
- SET L=27
- +5 if NAD=1
- SET PSJL=$$SETSTR^VALM1("in",PSJL,6,11)
- +6 DO NAME^PSIVUTL(DRG("SOL",NAD),L,.NAME,0)
- +7 ;#373 - Call to RENEWDT added
- FOR X=0:0
- SET X=$ORDER(NAME(X))
- if 'X
- QUIT
- if (NAD>1!(X>1))
- SET PSJL=""
- SET PSJL=$$SETSTR^VALM1(NAME(X),PSJL,9,34)
- if X=1&PSJNOAD
- DO V
- if (NAD>1!(X>1))
- DO RENEWDT
- DO SETTMP^PSJLMPRI
- +8 SET PSJL=""
- End DoDot:1
- +9 QUIT
- AD ;
- +1 NEW NAME
- +2 SET NAD=0
- FOR
- SET NAD=$ORDER(DRG("AD",NAD))
- if 'NAD
- QUIT
- Begin DoDot:1
- +3 KILL NAME
- +4 ;D NAME^PSIVUTL(DRG("AD",NAD),30,.NAME,1)
- +5 DO NAME^PSIVUTL(DRG("AD",NAD),27,.NAME,1)
- +6 ;#373 - Call to RENEWDT added
- FOR X=0:0
- SET X=$ORDER(NAME(X))
- if 'X
- QUIT
- if (NAD>1!(X>1))
- SET PSJL=""
- SET PSJL=$$SETSTR^VALM1(NAME(X),PSJL,6,34)
- if (NAD=1&(X=1))
- DO V
- if (NAD>1!(X>1))
- DO RENEWDT
- DO SETTMP^PSJLMPRI
- +7 SET PSJL=""
- End DoDot:1
- +8 QUIT
- +9 ;
- V SET Y=$SELECT(ON["V":$PIECE($GET(^PS(55,DFN,"IV",+ON,9)),U),1:"")
- +1 IF +Y>0
- XECUTE ^DD("DD")
- SET Y=$PIECE(Y,",")_" "_$PIECE($PIECE(Y,"@",2),":",1,2)
- +2 IF '$TEST
- SET Y="** N/P **"
- +3 SET PSJL=$$SETSTR^VALM1(Y,PSJL,33,12)
- +4 SET PSJL=$$SETSTR^VALM1(" #"_$SELECT(ON["V":+$PIECE($GET(^PS(55,DFN,"IV",+ON,9)),U,2),1:0),PSJL,46,3)
- +5 if PSIVX1]""
- SET PSIVX2=PSIVX2+1
- +6 DO REST
- +7 QUIT
- ACL ;
- +1 FOR X3=1:1:71
- SET PSJL=PSJL_"-"
- if X3=34
- SET PSJL=PSJL_" A c t i v e "
- +2 QUIT
- NVL ;
- +1 FOR X3=1:1:71
- SET PSJL=PSJL_"-"
- if X3=34
- SET PSJL=PSJL_" N o n - V e r i f i e d "
- +2 QUIT
- NVCL ;
- +1 FOR X3=1:1:71
- SET PSJL=PSJL_"-"
- if X3=34
- SET PSJL=PSJL_" N o n - V e r i f i e d C o m p l e x "
- +2 QUIT
- POL ;
- +1 FOR X3=1:1:71
- SET PSJL=PSJL_"-"
- if X3=34
- SET PSJL=PSJL_" P e n d i n g "
- +2 QUIT
- POCL ;
- +1 FOR X3=1:1:66
- SET PSJL=PSJL_"-"
- if X3=34
- SET PSJL=PSJL_" P e n d i n g C o m p l e x "
- +2 QUIT
- NOL ;
- +1 FOR X3=1:1:66
- SET PSJL=PSJL_"-"
- if X3=34
- SET PSJL=PSJL_" N o t A c t i v e "
- +2 QUIT
- CLIN(CLINIC) ; Print Clinic Name section header
- +1 NEW LEFTALIN
- SET LEFTALIN=(80-$LENGTH(CLINIC))\2
- +2 FOR X3=1:1:71
- SET PSJL=PSJL_"-"
- if (X3=(LEFTALIN))
- SET PSJL=PSJL_CLINIC
- +3 QUIT
- DPL ;Recently dc/expired header
- +1 SET PSJDCEXP=$$RECDCEXP^PSJP()
- +2 FOR X3=1:1:71
- SET PSJL=PSJL_"-"
- if X3=15
- SET PSJL=PSJL_"Recently Discontinued/Expired (Last "_+$GET(PSJDCEXP)_" hours)"
- +3 QUIT
- NOC ;
- +1 FOR X3=1:1:66
- SET PSJL=PSJL_"-"
- if X3=34
- SET PSJL=PSJL_" No current IV information "
- +2 ;
- +3 SET PSJL=""
- +4 QUIT
- REST ;
- +1 SET PSJL=$$SETSTR^VALM1(P(4),PSJL,52,1)
- +2 ;S PSJL=$$SETSTR^VALM1($E($$ENDTC^PSGMI(P(2)),1,5),PSJL,55,5) ;#373
- +3 ;#373
- SET PSJL=$$SETSTR^VALM1($EXTRACT($$ENDTC2^PSGMI(P(2)),1,10),PSJL,55,10)
- +4 ;S PSJL=$$SETSTR^VALM1($E($$ENDTC^PSGMI(P(3)),1,5),PSJL,62,5) ;#373
- +5 ;#373
- SET PSJL=$$SETSTR^VALM1($EXTRACT($$ENDTC2^PSGMI(P(3)),1,10),PSJL,66,10)
- +6 ;S PSJL=$$SETSTR^VALM1($S(P(17)="R"&(ON'["V"):"R/I",$G(P(25))]"":P(25),1:P(17)),PSJL,69,2) ;#373
- +7 ;#373
- SET PSJL=$$SETSTR^VALM1($SELECT(P(17)="R"&(ON'["V"):"R/I",$GET(P(25))]"":P(25),1:P(17)),PSJL,77,2)
- +8 ;S PSJL=$$SETSTR^VALM1($S(ON["P":P("PRY"),1:""),PSJL,71,1) ;#373
- +9 ;#373
- SET PSJL=$$SETSTR^VALM1($SELECT(ON["P":P("PRY"),1:""),PSJL,79,1)
- +10 ;N PSJLRN S PSJLRN=$$LASTREN^PSJLMPRI(DFN,ON55) I PSJLRN S PSJLRN=$E($$ENDTC^PSGMI(PSJLRN),1,5) S PSJL=$$SETSTR^VALM1(PSJLRN,PSJL,74,5) ;#373
- +11 QUIT
- RENEWDT ; 373 - Put renewal date on 2nd line instead of 1st.
- +1 if RNWPRTD
- QUIT
- +2 NEW PSJLRN
- SET PSJLRN=$$LASTREN^PSJLMPRI(DFN,ON55)
- +3 IF PSJLRN
- Begin DoDot:1
- +4 SET PSJLRN=$EXTRACT($$ENDTC2^PSGMI(PSJLRN),1,10)
- +5 SET PSJL=$$SETSTR^VALM1("Renewed:",PSJL,55,8)
- +6 SET PSJL=$$SETSTR^VALM1(PSJLRN,PSJL,64,10)
- SET RNWPRTD=1
- End DoDot:1
- +7 QUIT
- XCHK ;
- +1 IF $EXTRACT(X)="?"
- WRITE !!?2,"Select order",$EXTRACT("s",PS'=1)," (1"
- if PS>1
- WRITE "-",PS
- WRITE ")."
- +2 IF $EXTRACT(X)="?"
- if $SELECT($ORDER(^TMP("PSIV",$JOB,PSIVST,ON))
- WRITE " Press RETURN to view more orders, or enter '^' to abort",!,"the profile, or 'A' to view Allergies."
- if $EXTRACT(X,1,2)="??"
- DO H2^PSGON
- KILL X
- QUIT
- +3 SET PSGLMT=PS
- DO ^PSGON
- QUIT
- +4 ;
- PSPD SET Y=$SELECT(PSIVST'="P":$PIECE($GET(^PS(55,DFN,"IV",+ON,9)),U),1:"")
- +1 XECUTE ^DD("DD")
- if Y=""
- SET PSJL=$$SETSTR^VALM1("** N/P **",PSJL,36,12)
- +2 if Y'=""
- SET PSJL=$$SETSTR^VALM1($PIECE(Y,","),PSJL,36,7)
- SET PSJL=$$SETSTR^VALM1($PIECE($PIECE(Y,"@",2),":",1,2),PSJL,43,45)
- +3 SET PSJL=PSJL_" #"_$SELECT(Y="":0,1:$PIECE(^PS(55,DFN,"IV",+ON,9),U,2))
- +4 DO REST
- +5 QUIT