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

PSJCLNOC.m

Go to the documentation of this file.
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