PSOLMUTL ;BIR/SAB - listman utilities ;29-May-2012 14:54;PLS
;;7.0;OUTPATIENT PHARMACY;**19,46,84,99,131,132,1005,1006,1013,148,268,225,305,1015**;DEC 1997;Build 62
;External reference FULL^VALM1 supported by dbia 10116
;External reference $$SETSTR^VALM1 supported by dbia 10116
;External reference EN2^GMRAPEMO supported by dbia 190
;External reference to ^ORD(101 supported by DBIA 872
;External reference to RE^VALM4 supported by dbia 10120
;
; Modified - IHS/CIA/PLS - 12/10/03 - Line HDR+3
; IHS/MSC/PLS - 10/11/07 - Line HDR+12 and HDR+14
; 09/16/2011 - Line HDR+8
EN W @IOF S VALMCNT=0
D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!?5,"Site parameter must be defined!",! G INITQ
D EN^PSOLMPI
INITQ Q
HDR ;patient med profile display
K VALMHDR S HDR=^TMP("PSOHDR",$J,1,0)
S:^TMP("PSOHDR",$J,8,0) X=IORVON_"<A>"_IORVOFF,HDR=$$SETSTR^VALM1(X,HDR,80-$L(X),80) S VALMHDR(1)=HDR
I '(^TMP("PSOHDR",$J,8,0)) S PSONOAL="" D ALLERGY^PSOORUT2 I PSONOAL'="" D K PSONOAL
.S X=IORVON_"<NO ALLERGY ASSESSMENT>"_IORVOFF,HDR=$$SETSTR^VALM1(X,HDR,80-$L(X),80) S VALMHDR(1)=HDR
; IHS/CIA/PLS - 12/10/03 added call to retrieve HRN, HT and WT from PCC Vitals
;S HDR=" PID: "_^TMP("PSOHDR",$J,2,0)
;S VALMHDR(2)=$$SETSTR^VALM1("Ht(cm): "_^TMP("PSOHDR",$J,7,0),HDR,52,27)
;S HDR=" DOB: "_^TMP("PSOHDR",$J,3,0)_" ("_^TMP("PSOHDR",$J,4,0)_")"
;S VALMHDR(3)=$$SETSTR^VALM1(" Wt(kg): "_^TMP("PSOHDR",$J,6,0),HDR,51,28)
;IHS/MSC/PLS - 09/16/2011 - Added mask to SSN
;S HDR=" PID: "_^TMP("PSOHDR",$J,2,0)_" (HRN: "_$G(VA("PID"))_")"
S HDR=" PID: "_$$FMTSSN^APSPFUNC(^TMP("PSOHDR",$J,2,0))_" (HRN: "_$G(VA("PID"))_")"
S VALMHDR(2)=$$SETSTR^VALM1("Ht(cm): "_^TMP("PSOHDR",$J,7,0),HDR,52,27)
S HDR=" DOB: "_^TMP("PSOHDR",$J,3,0)_" ("_^TMP("PSOHDR",$J,4,0)_")"
S VALMHDR(3)=$$SETSTR^VALM1(" Wt(kg): "_^TMP("PSOHDR",$J,6,0),HDR,51,28)
S HDR=" SEX: "_$E(^TMP("PSOHDR",$J,5,0),1,45) ;IHS/MSC/PLS - 10/11/07 - CHANGED 44 TO 45
S VALMHDR(4)=HDR
S $P(VALMHDR(5)," ",26)=" "_$E(^TMP("PSOHDR",$J,5,0),48,80) ;IHS/MSC/PLS - 10/11/07 - CHANGED 30 TO 26
Q:$G(PS)="VIEW"!($G(PS)="DELETE")
;S $P(VALMHDR(5)," ",30)=$E(^TMP("PSOHDR",$J,5,0),48,80)
S VALMHDR(6)=^TMP("PSOHDR",$J,9,0)
S VALMHDR(7)=^TMP("PSOHDR",$J,10,0)
Q
;
NEWALL(DFN) ; Enter Allergy info.
N PSOID D FULL^VALM1,EN2^GMRAPEM0,^PSOORUT2 S VALMBCK="R"
Q
NEWSEL ;allows order selection by number instead of action
S Y=$P(XQORNOD(0),"=",2) N VALMCNT D NEWSEL^PSOORNE2
Q
EDTSEL ;allows edit selection by number instead of action - active orders
N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOOREDT
Q
SELAL ;selection of allergy by number instead of action - select allergy
N VALMCNT S Y=$P(XQORNOD(0),"=",2) D SELAL^PSOORDA
Q
EDTNEW ;allows edit selection by number instead of action - new orders
N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOORNE1
Q
EDTRNEW ;allows edit selection by number instead of action - renew orders
N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOORNE4
Q
EDTPEN ;allows edit selection by number instead of action - pending orders
N VALMCNT S Y=$P(XQORNOD(0),"=",2),SEDT=1 G EDTSEL^PSOORNEW
Q
HLDHDR ;keeps patient's header info
S IOTM=VALM("TM"),IOBM=IOSL W IOSC W @IOSTBM W IORC
Q
;
BYPASS S:$G(PSOFDR) SIGOK=1 S Y=-1,VALMBCK="Q"
Q
ACTIONS() ;screen actions on active orders
Q:$G(PKI1)=2 0
N DIC,X,Y K DIC,Y S DIC="^ORD(101,"_DA(1)_",10,",X=DA,DIC(0)="ZN" D ^DIC Q:Y<0 0
S Y=Y(0,0)
I Y="PSO REFILL" Q $S(PSOACT["R":1,1:0)
I Y="PSO RENEW" Q $S(PSOACT["N":1,1:0)
I Y="PSO REPRINT" Q $S(PSOACT["P":1,1:0)
I Y="PSO EDIT ORDERS" Q $S(PSOACT["E":1,1:0)
I Y="PSO RELEASE" Q $S(PSOACT["L":1,1:0)
I Y="PSO PARTIAL" Q $S(PSOACT["T":1,1:0)
I Y="PSO CANCEL" Q $S(PSOACT["D":1,1:0)
I Y="PSO HOLD" Q $S(PSOACT["H":1,1:0)
I Y="PSO UNHOLD" Q $S(PSOACT["U":1,1:0)
I Y="PSO LM BACKDOOR COPY" Q $S(PSOACT["C":1,1:0)
I Y="PSO VERIFY" Q $S(PSOACT["V":1,1:0)
I Y="PSO ACTIVITY LOGS" Q 1
Q 1
ACTIONS1() ;screen actions on pending orders
Q:$G(PKI1)=2 0
N DIC,X,Y K DIC,Y S DIC="^ORD(101,"_DA(1)_",10,",X=DA,DIC(0)="ZN" D ^DIC Q:Y<0 0
S Y=Y(0,0)
I Y="PSO LM DISCONTINUE" Q $S(PSOACT["D":1,1:0)
I Y="PSO LM EDIT" Q $S(PSOACT["E":1,1:0)
I Y="PSO LM FINISH" Q $S(PSOACT["F":1,1:0)
I Y="PSO LM FLAG" Q $S(PSOACT["X":1,1:0)
Q 1
PKIACT() ;screen actions on pending orders DEA/PKI proj.
Q:$G(PKI1)=2 0
Q 1
RFDSP ;screen action to toggle display of prescriptions between LAST FILL date and LAST RELEASE Date.
S PSORFG='$G(PSORFG)
I '$D(PSOSD) D ^PSOBUILD
D ^PSOORUT2,BLD^PSOORUT1
K VALMHDR
D RE^VALM4
Q
PSOLMUTL ;BIR/SAB - listman utilities ;29-May-2012 14:54;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**19,46,84,99,131,132,1005,1006,1013,148,268,225,305,1015**;DEC 1997;Build 62
+2 ;External reference FULL^VALM1 supported by dbia 10116
+3 ;External reference $$SETSTR^VALM1 supported by dbia 10116
+4 ;External reference EN2^GMRAPEMO supported by dbia 190
+5 ;External reference to ^ORD(101 supported by DBIA 872
+6 ;External reference to RE^VALM4 supported by dbia 10120
+7 ;
+8 ; Modified - IHS/CIA/PLS - 12/10/03 - Line HDR+3
+9 ; IHS/MSC/PLS - 10/11/07 - Line HDR+12 and HDR+14
+10 ; 09/16/2011 - Line HDR+8
EN WRITE @IOF
SET VALMCNT=0
+1 IF '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!?5,"Site parameter must be defined!",!
GOTO INITQ
+2 DO EN^PSOLMPI
INITQ QUIT
HDR ;patient med profile display
+1 KILL VALMHDR
SET HDR=^TMP("PSOHDR",$JOB,1,0)
+2 IF ^TMP("PSOHDR",$JOB,8,0)
SET X=IORVON_"<A>"_IORVOFF
SET HDR=$$SETSTR^VALM1(X,HDR,80-$LENGTH(X),80)
SET VALMHDR(1)=HDR
+3 IF '(^TMP("PSOHDR",$JOB,8,0))
SET PSONOAL=""
DO ALLERGY^PSOORUT2
IF PSONOAL'=""
Begin DoDot:1
+4 SET X=IORVON_"<NO ALLERGY ASSESSMENT>"_IORVOFF
SET HDR=$$SETSTR^VALM1(X,HDR,80-$LENGTH(X),80)
SET VALMHDR(1)=HDR
End DoDot:1
KILL PSONOAL
+5 ; IHS/CIA/PLS - 12/10/03 added call to retrieve HRN, HT and WT from PCC Vitals
+6 ;S HDR=" PID: "_^TMP("PSOHDR",$J,2,0)
+7 ;S VALMHDR(2)=$$SETSTR^VALM1("Ht(cm): "_^TMP("PSOHDR",$J,7,0),HDR,52,27)
+8 ;S HDR=" DOB: "_^TMP("PSOHDR",$J,3,0)_" ("_^TMP("PSOHDR",$J,4,0)_")"
+9 ;S VALMHDR(3)=$$SETSTR^VALM1(" Wt(kg): "_^TMP("PSOHDR",$J,6,0),HDR,51,28)
+10 ;IHS/MSC/PLS - 09/16/2011 - Added mask to SSN
+11 ;S HDR=" PID: "_^TMP("PSOHDR",$J,2,0)_" (HRN: "_$G(VA("PID"))_")"
+12 SET HDR=" PID: "_$$FMTSSN^APSPFUNC(^TMP("PSOHDR",$JOB,2,0))_" (HRN: "_$GET(VA("PID"))_")"
+13 SET VALMHDR(2)=$$SETSTR^VALM1("Ht(cm): "_^TMP("PSOHDR",$JOB,7,0),HDR,52,27)
+14 SET HDR=" DOB: "_^TMP("PSOHDR",$JOB,3,0)_" ("_^TMP("PSOHDR",$JOB,4,0)_")"
+15 SET VALMHDR(3)=$$SETSTR^VALM1(" Wt(kg): "_^TMP("PSOHDR",$JOB,6,0),HDR,51,28)
+16 ;IHS/MSC/PLS - 10/11/07 - CHANGED 44 TO 45
SET HDR=" SEX: "_$EXTRACT(^TMP("PSOHDR",$JOB,5,0),1,45)
+17 SET VALMHDR(4)=HDR
+18 ;IHS/MSC/PLS - 10/11/07 - CHANGED 30 TO 26
SET $PIECE(VALMHDR(5)," ",26)=" "_$EXTRACT(^TMP("PSOHDR",$JOB,5,0),48,80)
+19 IF $GET(PS)="VIEW"!($GET(PS)="DELETE")
QUIT
+20 ;S $P(VALMHDR(5)," ",30)=$E(^TMP("PSOHDR",$J,5,0),48,80)
+21 SET VALMHDR(6)=^TMP("PSOHDR",$JOB,9,0)
+22 SET VALMHDR(7)=^TMP("PSOHDR",$JOB,10,0)
+23 QUIT
+24 ;
NEWALL(DFN) ; Enter Allergy info.
+1 NEW PSOID
DO FULL^VALM1
DO EN2^GMRAPEM0
DO ^PSOORUT2
SET VALMBCK="R"
+2 QUIT
NEWSEL ;allows order selection by number instead of action
+1 SET Y=$PIECE(XQORNOD(0),"=",2)
NEW VALMCNT
DO NEWSEL^PSOORNE2
+2 QUIT
EDTSEL ;allows edit selection by number instead of action - active orders
+1 NEW VALMCNT
SET Y=$PIECE(XQORNOD(0),"=",2)
DO EDTSEL^PSOOREDT
+2 QUIT
SELAL ;selection of allergy by number instead of action - select allergy
+1 NEW VALMCNT
SET Y=$PIECE(XQORNOD(0),"=",2)
DO SELAL^PSOORDA
+2 QUIT
EDTNEW ;allows edit selection by number instead of action - new orders
+1 NEW VALMCNT
SET Y=$PIECE(XQORNOD(0),"=",2)
DO EDTSEL^PSOORNE1
+2 QUIT
EDTRNEW ;allows edit selection by number instead of action - renew orders
+1 NEW VALMCNT
SET Y=$PIECE(XQORNOD(0),"=",2)
DO EDTSEL^PSOORNE4
+2 QUIT
EDTPEN ;allows edit selection by number instead of action - pending orders
+1 NEW VALMCNT
SET Y=$PIECE(XQORNOD(0),"=",2)
SET SEDT=1
GOTO EDTSEL^PSOORNEW
+2 QUIT
HLDHDR ;keeps patient's header info
+1 SET IOTM=VALM("TM")
SET IOBM=IOSL
WRITE IOSC
WRITE @IOSTBM
WRITE IORC
+2 QUIT
+3 ;
BYPASS IF $GET(PSOFDR)
SET SIGOK=1
SET Y=-1
SET VALMBCK="Q"
+1 QUIT
ACTIONS() ;screen actions on active orders
+1 IF $GET(PKI1)=2
QUIT 0
+2 NEW DIC,X,Y
KILL DIC,Y
SET DIC="^ORD(101,"_DA(1)_",10,"
SET X=DA
SET DIC(0)="ZN"
DO ^DIC
IF Y<0
QUIT 0
+3 SET Y=Y(0,0)
+4 IF Y="PSO REFILL"
QUIT $SELECT(PSOACT["R":1,1:0)
+5 IF Y="PSO RENEW"
QUIT $SELECT(PSOACT["N":1,1:0)
+6 IF Y="PSO REPRINT"
QUIT $SELECT(PSOACT["P":1,1:0)
+7 IF Y="PSO EDIT ORDERS"
QUIT $SELECT(PSOACT["E":1,1:0)
+8 IF Y="PSO RELEASE"
QUIT $SELECT(PSOACT["L":1,1:0)
+9 IF Y="PSO PARTIAL"
QUIT $SELECT(PSOACT["T":1,1:0)
+10 IF Y="PSO CANCEL"
QUIT $SELECT(PSOACT["D":1,1:0)
+11 IF Y="PSO HOLD"
QUIT $SELECT(PSOACT["H":1,1:0)
+12 IF Y="PSO UNHOLD"
QUIT $SELECT(PSOACT["U":1,1:0)
+13 IF Y="PSO LM BACKDOOR COPY"
QUIT $SELECT(PSOACT["C":1,1:0)
+14 IF Y="PSO VERIFY"
QUIT $SELECT(PSOACT["V":1,1:0)
+15 IF Y="PSO ACTIVITY LOGS"
QUIT 1
+16 QUIT 1
ACTIONS1() ;screen actions on pending orders
+1 IF $GET(PKI1)=2
QUIT 0
+2 NEW DIC,X,Y
KILL DIC,Y
SET DIC="^ORD(101,"_DA(1)_",10,"
SET X=DA
SET DIC(0)="ZN"
DO ^DIC
IF Y<0
QUIT 0
+3 SET Y=Y(0,0)
+4 IF Y="PSO LM DISCONTINUE"
QUIT $SELECT(PSOACT["D":1,1:0)
+5 IF Y="PSO LM EDIT"
QUIT $SELECT(PSOACT["E":1,1:0)
+6 IF Y="PSO LM FINISH"
QUIT $SELECT(PSOACT["F":1,1:0)
+7 IF Y="PSO LM FLAG"
QUIT $SELECT(PSOACT["X":1,1:0)
+8 QUIT 1
PKIACT() ;screen actions on pending orders DEA/PKI proj.
+1 IF $GET(PKI1)=2
QUIT 0
+2 QUIT 1
RFDSP ;screen action to toggle display of prescriptions between LAST FILL date and LAST RELEASE Date.
+1 SET PSORFG='$GET(PSORFG)
+2 IF '$DATA(PSOSD)
DO ^PSOBUILD
+3 DO ^PSOORUT2
DO BLD^PSOORUT1
+4 KILL VALMHDR
+5 DO RE^VALM4
+6 QUIT
