PSJCLNOC ;BIR/LE - Clinic Order Check Utilities ;26 FEB 12 / 12:42 PM
;;5.0;INPATIENT MEDICATIONS ;**260,257,299,318,420**;16 DEC 97;Build 2
;Reference to ^PS(55 is supported by DBIA 2191
;
CLINICS(PSJDFN) ;
;Only clinics with yes to ADMINISTER INPATIENT MEDS in SET UP A CLINIC option and Rx's where a clinic and appt date/time are defined for the Rx are stored in
;the CIMO, CIMOU and CIMOI cross references.
N X,X1,X2,PSJSTDT,PSJCLIN,PSJCLINF,ORDID,PSJSTA,PSJUTMP,PSJTYP,PSJCANEX,PSJCLCOD,PST,PSJSTPDT,PSJTODAY,PSJCLIN,PSJXREF,PSJAPTDT,CLNDAYS,CLNDAY,OLDEST,PSJSTOP
N CLFILIEN,PSJTYPE,PSJSTAT
D NOW^%DTC S PSJTODAY=%
K ^TMP($J,"PSJPRE","CLINIC")
S (PSJSTDT,PSJCLIN,PSJCLINF,ORDID,PSJCLIN,CLFILIEN,CLNDAYS,CLNDAY,OLDEST)=""
S X1=PSJTODAY,X2=-120 D C^%DTC S (CLNDAY,PSJSTDT)=X
S PSJXREF="CIMOU"
F S PSJCLIN=$O(^PS(55,PSJXREF,PSJDFN,PSJCLIN)) Q:PSJCLIN="" D GETCLINF D
.F S PSJSTDT=$O(^PS(55,PSJXREF,PSJDFN,PSJCLIN,PSJSTDT)) Q:PSJSTDT="" F S ORDID=$O(^PS(55,PSJXREF,PSJDFN,PSJCLIN,PSJSTDT,PSJDFN,ORDID)) Q:ORDID="" D
..D SETTMP
S PSJXREF="CIMOI",(PSJCLIN,ORDID)="",PSJSTDT=CLNDAY
F S PSJCLIN=$O(^PS(55,PSJDFN,"IV",PSJXREF,PSJCLIN)) Q:PSJCLIN="" D GETCLINF D
.F S PSJSTDT=$O(^PS(55,PSJDFN,"IV",PSJXREF,PSJCLIN,PSJSTDT)) Q:PSJSTDT="" F S ORDID=$O(^PS(55,PSJDFN,"IV",PSJXREF,PSJCLIN,PSJSTDT,ORDID)) Q:ORDID="" D
..D SETTMP
;
D531 ;
S X1=PSJTODAY,X2=-120 D C^%DTC S (CLNDAY,PSJSTDT)=X
S (PSJSTDT,PSJCLIN,PSJCLINF,ORDID,PSJCLIN,CLFILIEN,CLNDAYS,CLNDAY,PSJTYPE)="",X1=PSJTODAY,X2=-120 D C^%DTC S PSJSTDT=X
F S PSJCLIN=$O(^PS(53.1,"CIMO",PSJDFN,PSJCLIN)) Q:PSJCLIN="" F S ORDID=$O(^PS(53.1,"CIMO",PSJDFN,PSJCLIN,ORDID)) Q:ORDID="" D
.S PSJSTAT=$$GET1^DIQ(53.1,ORDID,28)
.Q:$E(PSJSTAT)'="P"&($E(PSJSTAT)'="N")
.S CLFILIEN="",CLFILIEN=$O(^PS(53.46,"B",PSJCLIN,CLFILIEN)),(CLNDAYS,CLNDAY,OLDEST)=""
.S CLNDAYS=$$GET1^DIQ(53.46,CLFILIEN,6)
.S PSJTYPE=$$GET1^DIQ(53.1,ORDID,4,"I")
.I CLNDAYS="" S CLNDAYS=30
.S X1=PSJTODAY,X2=-CLNDAYS D C^%DTC S (PSJSTDT,CLNDAY)=X
.S ^TMP($J,"PSJPRE","CLINIC",ORDID,531_PSJTYPE)=CLNDAYS_"^"_PSJSTDT_"^"_PSJCLIN
Q
;
SETTMP ;
S ^TMP($J,"PSJPRE","CLINIC",ORDID,$S(PSJXREF="CIMOU":"55U",1:"55I"))=CLNDAYS_"^"_PSJSTDT_"^"_PSJCLIN
Q
;
GETCLINF ;
S CLFILIEN="",CLFILIEN=$O(^PS(53.46,"B",PSJCLIN,CLFILIEN)),(CLNDAYS,CLNDAY,OLDEST)=""
S CLNDAYS=$$GET1^DIQ(53.46,CLFILIEN,6)
I CLNDAYS="" S CLNDAYS=30
S X1=PSJTODAY,X2=-CLNDAYS D C^%DTC S (PSJSTDT,CLNDAY)=X
;S OLDEST="",OLDEST=$G(^TMP($J,"PSJPRE","CLINIC","OLDEST")) I CLNDAYS>OLDEST S ^TMP($J,"PSJPRE","CLINIC","OLDEST")=CLNDAYS
Q
;----------------------------------
CANEXP(DFN,ON,PSJCLCOD) ;
N FILE,ORTYPE,PIECE,FLDS,FLD1,FLD2,FLD3
S ORTYPE=$P(PSJCLCOD,";")
I ORTYPE=1 S FILE=55.06,FLDS=".03;100;109",FLD1=.03,FLD2=109,FLD3=100
I ORTYPE=2 S FILE=55.06,FLDS="28;34;48",FLD1=34,FLD2=48,FLD3=28
I ORTYPE=3!(ORTYPE=4) S FILE=53.1,FLDS="25;28;38",FLD1=25,FLD2=38,FLD3=28
;
CE ;check to see if Rx is outside the stop date + 90 days time frame
N CANEXPDT,PSJUTMP,PSJDCEXD,X1,X2,X,PSJCLNX
S (PSJCLNX,PSJDCEXD,CANEXPDT,X,X1,X2)=""
D GETS^DIQ(FILE,ON_","_DFN,FLDS,"I","PSJUTMP")
S:$D(PSJUTMP(FILE,ON_","_DFN_",",FLD3,"I")) PSJCLNX=PSJUTMP(FILE,ON_","_DFN_",",FLD3,"I")
S:'$D(PSJCLNX) PSJCLNX="" Q:PSJCLNX=""!('$D(PSJCLNX)) 0
I PSJCLNX="D" S:$D(PSJUTMP(FILE,ON_","_DFN_",",FLD1,"I")) CANEXPDT=PSJUTMP(FILE,ON_","_DFN_",",FLD1,"I")
I PSJCLNX="E"!(CANEXPDT="") S:$D(PSJUTMP(FILE,ON_","_DFN_",",FLD2,"I")) CANEXPDT=PSJUTMP(FILE,ON_","_DFN_",",FLD2,"I")
I CANEXPDT="" Q 0
S X1=CANEXPDT,X2=90 D C^%DTC S PSJDCEXD=X
I BDT>PSJDCEXD Q 0
Q 1
;---------------------------------
SETIN(PSJFLG,PSJPON,PSJNM,PSJCLCOD) ;
N TMP,STATUS,STARTDT,STOPDT,SCHEDULE,DOSAGE,ORDID,PSJCDFN,TYPE,FLG,INFUSE
S ORDID=$P(PSJCLCOD,";",1),PSJCDFN=$P(PSJCLCOD,";",3)
S TYPE="IN"
S ^TMP($J,LIST,"CLINIC",PSJPON)=ORDID_"^"_PSJCDFN_"^"_PSJNM_"^"_$P(PSJCLCOD,";",2)
Q
;
GET(PSJCON,PSJCDFN,ORDID,PSJCCODE,PSJNM,PSJCGET) ;
N TYPE,LIST
S TYPE="IN",LIST="PSJPRE",(DOSAGE,STATUS,STARTDT,STOPDT,SCHEDULE,INFUSE,STARTDTF,STOPDTF)=""
I PSJCCODE=1 S FLG=0 D GETF55
I PSJCCODE=2 S FLG=1 D GETF55
I PSJCCODE=3 D GETF531
I PSJCCODE=4!(PSJCCODE=5) D GETF531
Q
;
GETF55 ;get file 55 clinic info
D GETS^DIQ($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN,$S(FLG:"10;26;28;34;59;109",1:".02;.03;.08;.09;100;131"),,"TMP")
S:$D(TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:28,1:100))) STATUS=TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:28,1:100))
S:$D(TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:10,1:.02))) STARTDT=TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:10,1:.02))
S:$D(TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:34,1:.03))) STOPDT=TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:34,1:.03))
S:$D(TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:26,1:.09))) SCHEDULE=TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:26,1:.09))
S:$D(TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:109,1:131))) DOSAGE=TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:109,1:131))
S:$D(TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:59,1:.08))) INFUSE=TMP($S(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$S(FLG:59,1:.08))
S PSJCGET(ORDID)=STATUS_"^"_STARTDT_"^"_STOPDT_"^"_SCHEDULE_"^"_DOSAGE_"^"_INFUSE_"^"_PSJNM
Q:PSJCCODE=2!(PSJCCODE=4)
;IV additives and solutions
N ON1,PSJX,DDRUG,PSJ0,PSJDNAM
S ON1=0 F S ON1=$O(^PS(55,PSJCDFN,"IV",ORDID,"AD",ON1)) Q:'ON1!(ON1'?1N.N) D
. S PSJX=^PS(55,PSJCDFN,"IV",ORDID,"AD",ON1,0),PSJ0=$$IV0^PSJBLDOC("AD",+PSJX)
. S DDRUG=$P(PSJ0,U,2),PSJDNAM=$P(PSJ0,U)_" "_$P(PSJX,U,2)
. S PSJCGET(ORDID,"ADDITIVE",ON1)=PSJDNAM_"^"_DDRUG_"^"_ORDID_"^"_$P(PSJX,"^",3)
; Pre-mix in the OC.
S ON1=0 F S ON1=$O(^PS(55,PSJCDFN,"IV",ORDID,"SOL",ON1)) Q:'ON1!(ON1'?1N.N) D
. S PSJX=^PS(55,PSJCDFN,"IV",ORDID,"SOL",ON1,0)
. S PSJ0=$$IV0^PSJBLDOC("",+PSJX),DDRUG=$P(PSJ0,U,2)
. S PSJDNAM=$P(PSJ0,U)_" "_$P(PSJX,U,2),DDRUG=$P(PSJ0,U,2)
. S PSJCGET(ORDID,"SOLUTION",ON1)=PSJDNAM_"^"_DDRUG_"^"_INFUSE
Q
;
GETF531 ;get file 53.1 clinic info
D GETS^DIQ(53.1,ORDID_","_PSJCDFN,"28;10;25;26;27;109;115;116;117",,"TMP")
S:$D(TMP(53.1,ORDID_","_PSJCDFN_",",28)) STATUS=TMP(53.1,ORDID_","_PSJCDFN_",",28)
S:$D(TMP(53.1,ORDID_","_PSJCDFN_",",10)) STARTDT=TMP(53.1,ORDID_","_PSJCDFN_",",10)
I STARTDT="" S:$D(TMP(53.1,ORDID_","_PSJCDFN_",",115)) STARTDT=TMP(53.1,ORDID_","_PSJCDFN_",",115) S:STARTDT'="" STARTDTF=1
S:$D(TMP(53.1,ORDID_","_PSJCDFN_",",116)) DURATION=TMP(53.1,ORDID_","_PSJCDFN_",",116)
S:$D(TMP(53.1,ORDID_","_PSJCDFN_",",25)) STOPDT=TMP(53.1,ORDID_","_PSJCDFN_",",25)
I STOPDT="" S:$D(TMP(53.1,ORDID_","_PSJCDFN_",",117)) STOPDT=TMP(53.1,ORDID_","_PSJCDFN_",",117) S:STOPDT'="" STOPDTF=1
S:$D(TMP(53.1,ORDID_","_PSJCDFN_",",27)) ORDDATE=TMP(53.1,ORDID_","_PSJCDFN_",",27)
S:$D(TMP(53.1,ORDID_","_PSJCDFN_",",26)) SCHEDULE=TMP(53.1,ORDID_","_PSJCDFN_",",26)
S:$D(TMP(53.1,ORDID_","_PSJCDFN_",",109)) DOSAGE=TMP(53.1,ORDID_","_PSJCDFN_",",109)
S PSJCGET(ORDID)=STATUS_"^"_STARTDT_"^"_STOPDT_"^"_SCHEDULE_"^"_DOSAGE_"^"_INFUSE_"^"_PSJNM_"^"_STARTDTF_"^"_STOPDTF_"^"_ORDDATE
;IV additives and solutions
N ON1,PSJX,DDRUG,ADDITIVE,SOLUTION,PSJ0,PSJDNAM
S ON1=0 F S ON1=$O(^PS(53.1,ORDID,"AD",ON1)) Q:'ON1!(ON1'?1N.N) D
. S PSJX=^PS(53.1,ORDID,"AD",ON1,0),PSJ0=$$IV0^PSJBLDOC("AD",+PSJX)
. S DDRUG=$P(PSJ0,U,2),PSJDNAM=$P(PSJ0,U)_" "_$P(PSJX,U,2)
. S PSJCGET(ORDID,"ADDITIVE",ON1)=PSJDNAM_"^"_DDRUG_"^"_ORDID_"^"_$P(PSJX,"^",3)
; Pre-mix in the OC.
S ON1=0 F S ON1=$O(^PS(53.1,ORDID,"SOL",ON1)) Q:'ON1!(ON1'?1N.N) D
. S PSJX=^PS(53.1,ORDID,"SOL",ON1,0)
. S PSJ0=$$IV0^PSJBLDOC("",+PSJX)
. S DDRUG=$P(PSJ0,U,2)
. S PSJDNAM=$P(PSJ0,U)_" "_$P(PSJX,U,2),DDRUG=$P(PSJ0,U,2)
. S PSJCGET(ORDID,"SOLUTION",ON1)=PSJDNAM_"^"_DDRUG_"^"_INFUSE
Q
;
DISPCLN(PSJP,PSJCLINF) ;
N DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,DATA,PSJDSPON,PSJCON,PSJCDFN,PSJCGET,INFUSE,PSJCCODE,DURATION,STARTDTF,STOPDTF,ORDDATE
I $G(PSJSORT)>10 S PSJDSPON($P(PSJP(4),";",2))=""
DISP2 ;
S PSJCON=PSJP(4),PSJCGET=""
S PSJCDFN=DFN
S ORDID=$P(PSJCON,";",2),ORDID=+ORDID
S PSJCCODE=$P(PSJCLINF,";",1)
S (DRGNAME,PSJNM)=PSJP(2)
D GET(PSJCON,PSJCDFN,ORDID,PSJCCODE,PSJNM,.PSJCGET)
S DATA="",DATA=PSJCGET(ORDID)
Q:DATA=""
S (STATUS,STARTDT,STOPDT,SCHEDULE,DOSAGE)=""
S STATUS=$P(DATA,"^",1),STARTDT=$P(DATA,"^",2),STOPDT=$P(DATA,"^",3),SCHEDULE=$P(DATA,"^",4),DOSAGE=$P(DATA,"^",5)
S STARTDTF=$P(DATA,"^",8),STOPDTF=$P(DATA,"^",9),ORDDATE=$P(DATA,"^",10)
I ($Y+6)>IOSL D PAUSE^PSJMISC(1,0) W @IOF
W !,$J("Clinic Order: ",23)_$$CLNORDDN(.PSJP)_" ("_STATUS_")"
I $D(PSJCGET(ORDID,"ADDITIVE"))!($D(PSJCGET(ORDID,"SOLUTION"))) D IVDISP G EXIT
W !,$J("Schedule: ",23),SCHEDULE
W !,$J("Dosage: ",23),DOSAGE
I STARTDT=""&(ORDDATE'="") W !,$J("Order Date: ",23),ORDDATE
I STARTDT'="" W !,$J($S($G(STARTDTF):"Requested Start Date: ",1:"Start Date: "),23),STARTDT
E W !,$J("Start Date: ",23),"********"
I STOPDT'="" W !,$J($S($G(STOPDTF):"Requested Stop Date: ",1:"Stop Date: "),23),STOPDT
E W !,$J("Stop Date: ",23),"********"
W !
I ($Y+6)>IOSL D PAUSE^PSJMISC(1,0) W @IOF
EXIT ;
K PSJCGET
Q
;
CLNDISP(PSJCLINF) ;
N DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,DATA,PSJDSPON,PSJCON,PSJCDFN,PSJCGET,INFUSE,PSJCCODE,PSJP,STARTDTF,STOPDTF,ORDDATE
S PSJP(2)=PSJCLINF(3)
S PSJP(4)=PSJCLINF(2)
D DISP2
Q
;
IVDISP ;
N SEQ,ADATA,SDATA,DNAM,BOTTLE,AFLG,SFLG,SSEQ,SNAM,ADDS
S ADDS="",SEQ=0 F S SEQ=$O(PSJCGET(ORDID,"ADDITIVE",SEQ)) Q:SEQ="" D
.S ADATA=PSJCGET(ORDID,"ADDITIVE",SEQ)
.S DNAM=$P(ADATA,"^")
.Q:DNAM=DRGNAME
.S BOTTLE=$P(ADATA,"^",4)
.I '$G(AFLG) S ADDS=DNAM S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
.I $G(AFLG) S ADDS=ADDS_", "_DNAM S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
.W:'$G(AFLG) !,$J("Other Additive(s): ",23)
.S:'$G(AFLG) AFLG=1
I $G(AFLG) D MYWRITE^PSJMISC(ADDS,23,78)
S (SDATA,SNAM,INFUSE,SFLG)="",SSEQ=0
S SSEQ=0 F S SSEQ=$O(PSJCGET(ORDID,"SOLUTION",SSEQ)) Q:SSEQ="" D
.S SDATA=PSJCGET(ORDID,"SOLUTION",SSEQ)
.S SNAM=$P(SDATA,"^",1),INFUSE=$P(SDATA,"^",3)
.W:'$G(SFLG) !,$J("Solution(s): ",23)_SNAM_" "_INFUSE
.I $G(SFLG) W !?23,SNAM_" "_INFUSE
.S SFLG=1
W:SCHEDULE'="" !,$J("Schedule: ",23),SCHEDULE
I STARTDT=""&(ORDDATE'="") W !,$J("Order Date: ",23),ORDDATE
I STARTDT'="" W !,$J($S($G(STARTDTF):"Requested Start Date: ",1:"Start Date: "),23),STARTDT
E W !,$J("Start Date: ",23),"********"
I STOPDT'="" W !,$J($S($G(STOPDTF):"Requested Stop Date: ",1:"Stop Date: "),23),STOPDT
E W !,$J("Stop Date: ",23),"********"
W !
I ($Y+6)>IOSL D PAUSE^PSJMISC(1,0) W @IOF
Q
;
CLNORDDN(ORDINFO) ; Returns the Drug Name for a Clinic Order
;(Returns the drug name passed in with Array or Replace it with Orderable Item name if pending order does not have a dispense drug associated)
; Input: ORDERINFO - Array Containing Order Info. See example below:
; ORDINFO(2)="WARFARIN 7.5MG TAB U/D"
; ORDINFO(4)="C4;1850685P;PROFILE;3"
N CLNORDDN,ORDIEN,OIIEN
S CLNORDDN=$P($G(ORDINFO(2)),"^")
I $D(ORDINFO(4)),$P(ORDINFO(4),";",2)["P" D
. S ORDIEN=+$P(ORDINFO(4),";",2) I $O(^PS(53.1,ORDIEN,1,0)) Q
. S OIIEN=$$GET1^DIQ(53.1,ORDIEN,108,"I")
. S CLNORDDN=$$GET1^DIQ(50.7,OIIEN,.01)_" "_$$GET1^DIQ(50.7,OIIEN,.02)
Q CLNORDDN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJCLNOC 11454 printed Sep 23, 2025@19:42:27 Page 2
PSJCLNOC ;BIR/LE - Clinic Order Check Utilities ;26 FEB 12 / 12:42 PM
+1 ;;5.0;INPATIENT MEDICATIONS ;**260,257,299,318,420**;16 DEC 97;Build 2
+2 ;Reference to ^PS(55 is supported by DBIA 2191
+3 ;
CLINICS(PSJDFN) ;
+1 ;Only clinics with yes to ADMINISTER INPATIENT MEDS in SET UP A CLINIC option and Rx's where a clinic and appt date/time are defined for the Rx are stored in
+2 ;the CIMO, CIMOU and CIMOI cross references.
+3 NEW X,X1,X2,PSJSTDT,PSJCLIN,PSJCLINF,ORDID,PSJSTA,PSJUTMP,PSJTYP,PSJCANEX,PSJCLCOD,PST,PSJSTPDT,PSJTODAY,PSJCLIN,PSJXREF,PSJAPTDT,CLNDAYS,CLNDAY,OLDEST,PSJSTOP
+4 NEW CLFILIEN,PSJTYPE,PSJSTAT
+5 DO NOW^%DTC
SET PSJTODAY=%
+6 KILL ^TMP($JOB,"PSJPRE","CLINIC")
+7 SET (PSJSTDT,PSJCLIN,PSJCLINF,ORDID,PSJCLIN,CLFILIEN,CLNDAYS,CLNDAY,OLDEST)=""
+8 SET X1=PSJTODAY
SET X2=-120
DO C^%DTC
SET (CLNDAY,PSJSTDT)=X
+9 SET PSJXREF="CIMOU"
+10 FOR
SET PSJCLIN=$ORDER(^PS(55,PSJXREF,PSJDFN,PSJCLIN))
if PSJCLIN=""
QUIT
DO GETCLINF
Begin DoDot:1
+11 FOR
SET PSJSTDT=$ORDER(^PS(55,PSJXREF,PSJDFN,PSJCLIN,PSJSTDT))
if PSJSTDT=""
QUIT
FOR
SET ORDID=$ORDER(^PS(55,PSJXREF,PSJDFN,PSJCLIN,PSJSTDT,PSJDFN,ORDID))
if ORDID=""
QUIT
Begin DoDot:2
+12 DO SETTMP
End DoDot:2
End DoDot:1
+13 SET PSJXREF="CIMOI"
SET (PSJCLIN,ORDID)=""
SET PSJSTDT=CLNDAY
+14 FOR
SET PSJCLIN=$ORDER(^PS(55,PSJDFN,"IV",PSJXREF,PSJCLIN))
if PSJCLIN=""
QUIT
DO GETCLINF
Begin DoDot:1
+15 FOR
SET PSJSTDT=$ORDER(^PS(55,PSJDFN,"IV",PSJXREF,PSJCLIN,PSJSTDT))
if PSJSTDT=""
QUIT
FOR
SET ORDID=$ORDER(^PS(55,PSJDFN,"IV",PSJXREF,PSJCLIN,PSJSTDT,ORDID))
if ORDID=""
QUIT
Begin DoDot:2
+16 DO SETTMP
End DoDot:2
End DoDot:1
+17 ;
D531 ;
+1 SET X1=PSJTODAY
SET X2=-120
DO C^%DTC
SET (CLNDAY,PSJSTDT)=X
+2 SET (PSJSTDT,PSJCLIN,PSJCLINF,ORDID,PSJCLIN,CLFILIEN,CLNDAYS,CLNDAY,PSJTYPE)=""
SET X1=PSJTODAY
SET X2=-120
DO C^%DTC
SET PSJSTDT=X
+3 FOR
SET PSJCLIN=$ORDER(^PS(53.1,"CIMO",PSJDFN,PSJCLIN))
if PSJCLIN=""
QUIT
FOR
SET ORDID=$ORDER(^PS(53.1,"CIMO",PSJDFN,PSJCLIN,ORDID))
if ORDID=""
QUIT
Begin DoDot:1
+4 SET PSJSTAT=$$GET1^DIQ(53.1,ORDID,28)
+5 if $EXTRACT(PSJSTAT)'="P"&($EXTRACT(PSJSTAT)'="N")
QUIT
+6 SET CLFILIEN=""
SET CLFILIEN=$ORDER(^PS(53.46,"B",PSJCLIN,CLFILIEN))
SET (CLNDAYS,CLNDAY,OLDEST)=""
+7 SET CLNDAYS=$$GET1^DIQ(53.46,CLFILIEN,6)
+8 SET PSJTYPE=$$GET1^DIQ(53.1,ORDID,4,"I")
+9 IF CLNDAYS=""
SET CLNDAYS=30
+10 SET X1=PSJTODAY
SET X2=-CLNDAYS
DO C^%DTC
SET (PSJSTDT,CLNDAY)=X
+11 SET ^TMP($JOB,"PSJPRE","CLINIC",ORDID,531_PSJTYPE)=CLNDAYS_"^"_PSJSTDT_"^"_PSJCLIN
End DoDot:1
+12 QUIT
+13 ;
SETTMP ;
+1 SET ^TMP($JOB,"PSJPRE","CLINIC",ORDID,$SELECT(PSJXREF="CIMOU":"55U",1:"55I"))=CLNDAYS_"^"_PSJSTDT_"^"_PSJCLIN
+2 QUIT
+3 ;
GETCLINF ;
+1 SET CLFILIEN=""
SET CLFILIEN=$ORDER(^PS(53.46,"B",PSJCLIN,CLFILIEN))
SET (CLNDAYS,CLNDAY,OLDEST)=""
+2 SET CLNDAYS=$$GET1^DIQ(53.46,CLFILIEN,6)
+3 IF CLNDAYS=""
SET CLNDAYS=30
+4 SET X1=PSJTODAY
SET X2=-CLNDAYS
DO C^%DTC
SET (PSJSTDT,CLNDAY)=X
+5 ;S OLDEST="",OLDEST=$G(^TMP($J,"PSJPRE","CLINIC","OLDEST")) I CLNDAYS>OLDEST S ^TMP($J,"PSJPRE","CLINIC","OLDEST")=CLNDAYS
+6 QUIT
+7 ;----------------------------------
CANEXP(DFN,ON,PSJCLCOD) ;
+1 NEW FILE,ORTYPE,PIECE,FLDS,FLD1,FLD2,FLD3
+2 SET ORTYPE=$PIECE(PSJCLCOD,";")
+3 IF ORTYPE=1
SET FILE=55.06
SET FLDS=".03;100;109"
SET FLD1=.03
SET FLD2=109
SET FLD3=100
+4 IF ORTYPE=2
SET FILE=55.06
SET FLDS="28;34;48"
SET FLD1=34
SET FLD2=48
SET FLD3=28
+5 IF ORTYPE=3!(ORTYPE=4)
SET FILE=53.1
SET FLDS="25;28;38"
SET FLD1=25
SET FLD2=38
SET FLD3=28
+6 ;
CE ;check to see if Rx is outside the stop date + 90 days time frame
+1 NEW CANEXPDT,PSJUTMP,PSJDCEXD,X1,X2,X,PSJCLNX
+2 SET (PSJCLNX,PSJDCEXD,CANEXPDT,X,X1,X2)=""
+3 DO GETS^DIQ(FILE,ON_","_DFN,FLDS,"I","PSJUTMP")
+4 if $DATA(PSJUTMP(FILE,ON_","_DFN_",",FLD3,"I"))
SET PSJCLNX=PSJUTMP(FILE,ON_","_DFN_",",FLD3,"I")
+5 if '$DATA(PSJCLNX)
SET PSJCLNX=""
if PSJCLNX=""!('$DATA(PSJCLNX))
QUIT 0
+6 IF PSJCLNX="D"
if $DATA(PSJUTMP(FILE,ON_","_DFN_",",FLD1,"I"))
SET CANEXPDT=PSJUTMP(FILE,ON_","_DFN_",",FLD1,"I")
+7 IF PSJCLNX="E"!(CANEXPDT="")
if $DATA(PSJUTMP(FILE,ON_","_DFN_",",FLD2,"I"))
SET CANEXPDT=PSJUTMP(FILE,ON_","_DFN_",",FLD2,"I")
+8 IF CANEXPDT=""
QUIT 0
+9 SET X1=CANEXPDT
SET X2=90
DO C^%DTC
SET PSJDCEXD=X
+10 IF BDT>PSJDCEXD
QUIT 0
+11 QUIT 1
+12 ;---------------------------------
SETIN(PSJFLG,PSJPON,PSJNM,PSJCLCOD) ;
+1 NEW TMP,STATUS,STARTDT,STOPDT,SCHEDULE,DOSAGE,ORDID,PSJCDFN,TYPE,FLG,INFUSE
+2 SET ORDID=$PIECE(PSJCLCOD,";",1)
SET PSJCDFN=$PIECE(PSJCLCOD,";",3)
+3 SET TYPE="IN"
+4 SET ^TMP($JOB,LIST,"CLINIC",PSJPON)=ORDID_"^"_PSJCDFN_"^"_PSJNM_"^"_$PIECE(PSJCLCOD,";",2)
+5 QUIT
+6 ;
GET(PSJCON,PSJCDFN,ORDID,PSJCCODE,PSJNM,PSJCGET) ;
+1 NEW TYPE,LIST
+2 SET TYPE="IN"
SET LIST="PSJPRE"
SET (DOSAGE,STATUS,STARTDT,STOPDT,SCHEDULE,INFUSE,STARTDTF,STOPDTF)=""
+3 IF PSJCCODE=1
SET FLG=0
DO GETF55
+4 IF PSJCCODE=2
SET FLG=1
DO GETF55
+5 IF PSJCCODE=3
DO GETF531
+6 IF PSJCCODE=4!(PSJCCODE=5)
DO GETF531
+7 QUIT
+8 ;
GETF55 ;get file 55 clinic info
+1 DO GETS^DIQ($SELECT(FLG:55.06,1:55.01),ORDID_","_PSJCDFN,$SELECT(FLG:"10;26;28;34;59;109",1:".02;.03;.08;.09;100;131"),,"TMP")
+2 if $DATA(TMP($SELECT(FLG
SET STATUS=TMP($SELECT(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$SELECT(FLG:28,1:100))
+3 if $DATA(TMP($SELECT(FLG
SET STARTDT=TMP($SELECT(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$SELECT(FLG:10,1:.02))
+4 if $DATA(TMP($SELECT(FLG
SET STOPDT=TMP($SELECT(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$SELECT(FLG:34,1:.03))
+5 if $DATA(TMP($SELECT(FLG
SET SCHEDULE=TMP($SELECT(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$SELECT(FLG:26,1:.09))
+6 if $DATA(TMP($SELECT(FLG
SET DOSAGE=TMP($SELECT(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$SELECT(FLG:109,1:131))
+7 if $DATA(TMP($SELECT(FLG
SET INFUSE=TMP($SELECT(FLG:55.06,1:55.01),ORDID_","_PSJCDFN_",",$SELECT(FLG:59,1:.08))
+8 SET PSJCGET(ORDID)=STATUS_"^"_STARTDT_"^"_STOPDT_"^"_SCHEDULE_"^"_DOSAGE_"^"_INFUSE_"^"_PSJNM
+9 if PSJCCODE=2!(PSJCCODE=4)
QUIT
+10 ;IV additives and solutions
+11 NEW ON1,PSJX,DDRUG,PSJ0,PSJDNAM
+12 SET ON1=0
FOR
SET ON1=$ORDER(^PS(55,PSJCDFN,"IV",ORDID,"AD",ON1))
if 'ON1!(ON1'?1N.N)
QUIT
Begin DoDot:1
+13 SET PSJX=^PS(55,PSJCDFN,"IV",ORDID,"AD",ON1,0)
SET PSJ0=$$IV0^PSJBLDOC("AD",+PSJX)
+14 SET DDRUG=$PIECE(PSJ0,U,2)
SET PSJDNAM=$PIECE(PSJ0,U)_" "_$PIECE(PSJX,U,2)
+15 SET PSJCGET(ORDID,"ADDITIVE",ON1)=PSJDNAM_"^"_DDRUG_"^"_ORDID_"^"_$PIECE(PSJX,"^",3)
End DoDot:1
+16 ; Pre-mix in the OC.
+17 SET ON1=0
FOR
SET ON1=$ORDER(^PS(55,PSJCDFN,"IV",ORDID,"SOL",ON1))
if 'ON1!(ON1'?1N.N)
QUIT
Begin DoDot:1
+18 SET PSJX=^PS(55,PSJCDFN,"IV",ORDID,"SOL",ON1,0)
+19 SET PSJ0=$$IV0^PSJBLDOC("",+PSJX)
SET DDRUG=$PIECE(PSJ0,U,2)
+20 SET PSJDNAM=$PIECE(PSJ0,U)_" "_$PIECE(PSJX,U,2)
SET DDRUG=$PIECE(PSJ0,U,2)
+21 SET PSJCGET(ORDID,"SOLUTION",ON1)=PSJDNAM_"^"_DDRUG_"^"_INFUSE
End DoDot:1
+22 QUIT
+23 ;
GETF531 ;get file 53.1 clinic info
+1 DO GETS^DIQ(53.1,ORDID_","_PSJCDFN,"28;10;25;26;27;109;115;116;117",,"TMP")
+2 if $DATA(TMP(53.1,ORDID_","_PSJCDFN_",",28))
SET STATUS=TMP(53.1,ORDID_","_PSJCDFN_",",28)
+3 if $DATA(TMP(53.1,ORDID_","_PSJCDFN_",",10))
SET STARTDT=TMP(53.1,ORDID_","_PSJCDFN_",",10)
+4 IF STARTDT=""
if $DATA(TMP(53.1,ORDID_","_PSJCDFN_",",115))
SET STARTDT=TMP(53.1,ORDID_","_PSJCDFN_",",115)
if STARTDT'=""
SET STARTDTF=1
+5 if $DATA(TMP(53.1,ORDID_","_PSJCDFN_",",116))
SET DURATION=TMP(53.1,ORDID_","_PSJCDFN_",",116)
+6 if $DATA(TMP(53.1,ORDID_","_PSJCDFN_",",25))
SET STOPDT=TMP(53.1,ORDID_","_PSJCDFN_",",25)
+7 IF STOPDT=""
if $DATA(TMP(53.1,ORDID_","_PSJCDFN_",",117))
SET STOPDT=TMP(53.1,ORDID_","_PSJCDFN_",",117)
if STOPDT'=""
SET STOPDTF=1
+8 if $DATA(TMP(53.1,ORDID_","_PSJCDFN_",",27))
SET ORDDATE=TMP(53.1,ORDID_","_PSJCDFN_",",27)
+9 if $DATA(TMP(53.1,ORDID_","_PSJCDFN_",",26))
SET SCHEDULE=TMP(53.1,ORDID_","_PSJCDFN_",",26)
+10 if $DATA(TMP(53.1,ORDID_","_PSJCDFN_",",109))
SET DOSAGE=TMP(53.1,ORDID_","_PSJCDFN_",",109)
+11 SET PSJCGET(ORDID)=STATUS_"^"_STARTDT_"^"_STOPDT_"^"_SCHEDULE_"^"_DOSAGE_"^"_INFUSE_"^"_PSJNM_"^"_STARTDTF_"^"_STOPDTF_"^"_ORDDATE
+12 ;IV additives and solutions
+13 NEW ON1,PSJX,DDRUG,ADDITIVE,SOLUTION,PSJ0,PSJDNAM
+14 SET ON1=0
FOR
SET ON1=$ORDER(^PS(53.1,ORDID,"AD",ON1))
if 'ON1!(ON1'?1N.N)
QUIT
Begin DoDot:1
+15 SET PSJX=^PS(53.1,ORDID,"AD",ON1,0)
SET PSJ0=$$IV0^PSJBLDOC("AD",+PSJX)
+16 SET DDRUG=$PIECE(PSJ0,U,2)
SET PSJDNAM=$PIECE(PSJ0,U)_" "_$PIECE(PSJX,U,2)
+17 SET PSJCGET(ORDID,"ADDITIVE",ON1)=PSJDNAM_"^"_DDRUG_"^"_ORDID_"^"_$PIECE(PSJX,"^",3)
End DoDot:1
+18 ; Pre-mix in the OC.
+19 SET ON1=0
FOR
SET ON1=$ORDER(^PS(53.1,ORDID,"SOL",ON1))
if 'ON1!(ON1'?1N.N)
QUIT
Begin DoDot:1
+20 SET PSJX=^PS(53.1,ORDID,"SOL",ON1,0)
+21 SET PSJ0=$$IV0^PSJBLDOC("",+PSJX)
+22 SET DDRUG=$PIECE(PSJ0,U,2)
+23 SET PSJDNAM=$PIECE(PSJ0,U)_" "_$PIECE(PSJX,U,2)
SET DDRUG=$PIECE(PSJ0,U,2)
+24 SET PSJCGET(ORDID,"SOLUTION",ON1)=PSJDNAM_"^"_DDRUG_"^"_INFUSE
End DoDot:1
+25 QUIT
+26 ;
DISPCLN(PSJP,PSJCLINF) ;
+1 NEW DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,DATA,PSJDSPON,PSJCON,PSJCDFN,PSJCGET,INFUSE,PSJCCODE,DURATION,STARTDTF,STOPDTF,ORDDATE
+2 IF $GET(PSJSORT)>10
SET PSJDSPON($PIECE(PSJP(4),";",2))=""
DISP2 ;
+1 SET PSJCON=PSJP(4)
SET PSJCGET=""
+2 SET PSJCDFN=DFN
+3 SET ORDID=$PIECE(PSJCON,";",2)
SET ORDID=+ORDID
+4 SET PSJCCODE=$PIECE(PSJCLINF,";",1)
+5 SET (DRGNAME,PSJNM)=PSJP(2)
+6 DO GET(PSJCON,PSJCDFN,ORDID,PSJCCODE,PSJNM,.PSJCGET)
+7 SET DATA=""
SET DATA=PSJCGET(ORDID)
+8 if DATA=""
QUIT
+9 SET (STATUS,STARTDT,STOPDT,SCHEDULE,DOSAGE)=""
+10 SET STATUS=$PIECE(DATA,"^",1)
SET STARTDT=$PIECE(DATA,"^",2)
SET STOPDT=$PIECE(DATA,"^",3)
SET SCHEDULE=$PIECE(DATA,"^",4)
SET DOSAGE=$PIECE(DATA,"^",5)
+11 SET STARTDTF=$PIECE(DATA,"^",8)
SET STOPDTF=$PIECE(DATA,"^",9)
SET ORDDATE=$PIECE(DATA,"^",10)
+12 IF ($Y+6)>IOSL
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
+13 WRITE !,$JUSTIFY("Clinic Order: ",23)_$$CLNORDDN(.PSJP)_" ("_STATUS_")"
+14 IF $DATA(PSJCGET(ORDID,"ADDITIVE"))!($DATA(PSJCGET(ORDID,"SOLUTION")))
DO IVDISP
GOTO EXIT
+15 WRITE !,$JUSTIFY("Schedule: ",23),SCHEDULE
+16 WRITE !,$JUSTIFY("Dosage: ",23),DOSAGE
+17 IF STARTDT=""&(ORDDATE'="")
WRITE !,$JUSTIFY("Order Date: ",23),ORDDATE
+18 IF STARTDT'=""
WRITE !,$JUSTIFY($SELECT($GET(STARTDTF):"Requested Start Date: ",1:"Start Date: "),23),STARTDT
+19 IF '$TEST
WRITE !,$JUSTIFY("Start Date: ",23),"********"
+20 IF STOPDT'=""
WRITE !,$JUSTIFY($SELECT($GET(STOPDTF):"Requested Stop Date: ",1:"Stop Date: "),23),STOPDT
+21 IF '$TEST
WRITE !,$JUSTIFY("Stop Date: ",23),"********"
+22 WRITE !
+23 IF ($Y+6)>IOSL
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
EXIT ;
+1 KILL PSJCGET
+2 QUIT
+3 ;
CLNDISP(PSJCLINF) ;
+1 NEW DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,DATA,PSJDSPON,PSJCON,PSJCDFN,PSJCGET,INFUSE,PSJCCODE,PSJP,STARTDTF,STOPDTF,ORDDATE
+2 SET PSJP(2)=PSJCLINF(3)
+3 SET PSJP(4)=PSJCLINF(2)
+4 DO DISP2
+5 QUIT
+6 ;
IVDISP ;
+1 NEW SEQ,ADATA,SDATA,DNAM,BOTTLE,AFLG,SFLG,SSEQ,SNAM,ADDS
+2 SET ADDS=""
SET SEQ=0
FOR
SET SEQ=$ORDER(PSJCGET(ORDID,"ADDITIVE",SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+3 SET ADATA=PSJCGET(ORDID,"ADDITIVE",SEQ)
+4 SET DNAM=$PIECE(ADATA,"^")
+5 if DNAM=DRGNAME
QUIT
+6 SET BOTTLE=$PIECE(ADATA,"^",4)
+7 IF '$GET(AFLG)
SET ADDS=DNAM
if BOTTLE'=""
SET ADDS=ADDS_" ("_BOTTLE_")"
+8 IF $GET(AFLG)
SET ADDS=ADDS_", "_DNAM
if BOTTLE'=""
SET ADDS=ADDS_" ("_BOTTLE_")"
+9 if '$GET(AFLG)
WRITE !,$JUSTIFY("Other Additive(s): ",23)
+10 if '$GET(AFLG)
SET AFLG=1
End DoDot:1
+11 IF $GET(AFLG)
DO MYWRITE^PSJMISC(ADDS,23,78)
+12 SET (SDATA,SNAM,INFUSE,SFLG)=""
SET SSEQ=0
+13 SET SSEQ=0
FOR
SET SSEQ=$ORDER(PSJCGET(ORDID,"SOLUTION",SSEQ))
if SSEQ=""
QUIT
Begin DoDot:1
+14 SET SDATA=PSJCGET(ORDID,"SOLUTION",SSEQ)
+15 SET SNAM=$PIECE(SDATA,"^",1)
SET INFUSE=$PIECE(SDATA,"^",3)
+16 if '$GET(SFLG)
WRITE !,$JUSTIFY("Solution(s): ",23)_SNAM_" "_INFUSE
+17 IF $GET(SFLG)
WRITE !?23,SNAM_" "_INFUSE
+18 SET SFLG=1
End DoDot:1
+19 if SCHEDULE'=""
WRITE !,$JUSTIFY("Schedule: ",23),SCHEDULE
+20 IF STARTDT=""&(ORDDATE'="")
WRITE !,$JUSTIFY("Order Date: ",23),ORDDATE
+21 IF STARTDT'=""
WRITE !,$JUSTIFY($SELECT($GET(STARTDTF):"Requested Start Date: ",1:"Start Date: "),23),STARTDT
+22 IF '$TEST
WRITE !,$JUSTIFY("Start Date: ",23),"********"
+23 IF STOPDT'=""
WRITE !,$JUSTIFY($SELECT($GET(STOPDTF):"Requested Stop Date: ",1:"Stop Date: "),23),STOPDT
+24 IF '$TEST
WRITE !,$JUSTIFY("Stop Date: ",23),"********"
+25 WRITE !
+26 IF ($Y+6)>IOSL
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
+27 QUIT
+28 ;
CLNORDDN(ORDINFO) ; Returns the Drug Name for a Clinic Order
+1 ;(Returns the drug name passed in with Array or Replace it with Orderable Item name if pending order does not have a dispense drug associated)
+2 ; Input: ORDERINFO - Array Containing Order Info. See example below:
+3 ; ORDINFO(2)="WARFARIN 7.5MG TAB U/D"
+4 ; ORDINFO(4)="C4;1850685P;PROFILE;3"
+5 NEW CLNORDDN,ORDIEN,OIIEN
+6 SET CLNORDDN=$PIECE($GET(ORDINFO(2)),"^")
+7 IF $DATA(ORDINFO(4))
IF $PIECE(ORDINFO(4),";",2)["P"
Begin DoDot:1
+8 SET ORDIEN=+$PIECE(ORDINFO(4),";",2)
IF $ORDER(^PS(53.1,ORDIEN,1,0))
QUIT
+9 SET OIIEN=$$GET1^DIQ(53.1,ORDIEN,108,"I")
+10 SET CLNORDDN=$$GET1^DIQ(50.7,OIIEN,.01)_" "_$$GET1^DIQ(50.7,OIIEN,.02)
End DoDot:1
+11 QUIT CLNORDDN
