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

PSJIMO1.m

Go to the documentation of this file.
  1. PSJIMO1 ;BIR/LE - IMO UTILITIES AND XREFS ;16 Mar 99 / 10:22 AM
  1. ;;5.0;INPATIENT MEDICATIONS ;**257,299,311,307,335**;16 DEC 97;Build 6
  1. ;External reference to ^PS(55 supported by DBIA 2191
  1. ;External reference to ^PSSDSAPI supported by DBIA 5425
  1. ;External Reference to ^DPTLK is supported by DBIA 3787
  1. ;
  1. IMO(CLINICS) ;called from ENCD^PSGFILED WHICH IS CLINIC DEFINITION OPTION IN INPATIENT MEDS
  1. W !!,"Verifying IMO clinic cross references...",!
  1. N CLINFLG,IMOCLIEN,PSJIMOCL,PSJCLIN,FLAG S FLAG=""
  1. S (CLINFLG,CLINIC,PSJIMOCL,IMOCLIEN)=""
  1. F S IMOCLIEN=$O(CLINICS(IMOCLIEN)) Q:IMOCLIEN="" S PSJIMOCL=$$GET1^DIQ(53.46,IMOCLIEN,.01,"I"),CLINFLG=$$GET1^DIQ(44,PSJIMOCL,2802,"I") D
  1. .I 'CLINFLG D IMOKILL(PSJIMOCL,CLINFLG) Q ;CLINFLG=ADIMINISTER INPATIENT MEDS? true means IMO clinic; false means not IMO
  1. .I CLINFLG D IMOSET(PSJIMOCL,CLINFLG,IMOCLIEN)
  1. I FLAG W !,"IMO cross references have been updated.",!
  1. Q
  1. ;
  1. IMOSET(PSJCLIN,PSJIMOF,CLINIC) ;
  1. ;Clinic order means Yes is answered to ADMINISTER INPATIENT MEDS field in file 44, a clinic and appointment date/time is defined.
  1. ;Q:$D(^PS("CIMOCLU",CLINIC))!($D(^PS("CIMOCLI",CLINIC)))
  1. N CLNDAYS,PSJAPTDT,PSJTODAY,X1,X2,PATIENT,PSJSTDT,PS55IEN,PS531IEN,PSJXREF,PSJTYPE,APPTDT,PSJUTMP,PSJSTART
  1. S CLNDAYS=$$GET1^DIQ(53.46,CLINIC,6)
  1. S:CLNDAYS="" CLNDAYS=30 ;default to 30 days if not defined
  1. D NOW^%DTC S (X1,PSJTODAY)=%,X2=-CLNDAYS D C^%DTC S PSJSTART=X
  1. ;FILE 55
  1. F PSJXREF="AUDC","AIVC" S PSJSTDT=PSJSTART F S PSJSTDT=$O(^PS(55,PSJXREF,PSJSTDT)) Q:PSJSTDT="" D
  1. .S PATIENT="" F S PATIENT=$O(^PS(55,PSJXREF,PSJSTDT,PSJCLIN,PATIENT)) Q:PATIENT="" S PS55IEN="" F S PS55IEN=$O(^PS(55,PSJXREF,PSJSTDT,PSJCLIN,PATIENT,PS55IEN)) Q:PS55IEN="" D
  1. ..I PSJXREF="AUDC" S PSJAPTDT=$$GET1^DIQ(55.06,PS55IEN_","_PATIENT_",",131) I PSJAPTDT'="" S ^PS(55,"CIMOU",PATIENT,PSJCLIN,PSJSTDT,PATIENT,PS55IEN)=""
  1. ..I PSJXREF="AIVC" S PSJAPTDT=$$GET1^DIQ(55.01,PS55IEN_","_PATIENT_",",139) I PSJAPTDT'="" S ^PS(55,PATIENT,"IV","CIMOI",PSJCLIN,PSJSTDT,PS55IEN)=""
  1. ..I PSJAPTDT'="" S FLAG=1
  1. ;
  1. ;FILE 53.1
  1. S (PATIENT,PS531IEN)=""
  1. F S PATIENT=$O(^PS(53.1,"AD",PSJCLIN,PATIENT)) Q:PATIENT="" F S PS531IEN=$O(^PS(53.1,"AD",PSJCLIN,PATIENT,PS531IEN)) Q:PS531IEN="" D
  1. .K PSJUTMP D GETS^DIQ(53.1,PS531IEN,"28;126","I","PSJUTMP")
  1. .S (APPTDT,PSJTYPE)=""
  1. .S:$D(PSJUTMP(53.1,PS531IEN_",",126,"I")) APPTDT=PSJUTMP(53.1,PS531IEN_",",126,"I")
  1. .S:$D(PSJUTMP(53.1,PS531IEN_",",28,"I")) PSJTYPE=PSJUTMP(53.1,PS531IEN_",",28,"I")
  1. .Q:PSJTYPE'="P"&(PSJTYPE'="N")
  1. .Q:APPTDT=""!'CLINFLG
  1. .S ^PS(53.1,"CIMO",PATIENT,PSJCLIN,PS531IEN)="",FLAG=1
  1. Q
  1. ;
  1. IMOKILL(CLINIC,PSCLINIC) ;
  1. S:'$G(PSCLINIC) PSCLINIC=""
  1. I $D(^PS(55,"CIMOCLU",CLINIC)) S PATIENT="" F S PATIENT=$O(^PS(55,"CIMOCLU",CLINIC,PATIENT)) Q:PATIENT="" D
  1. .K ^PS(55,"CIMOU",PATIENT,CLINIC)
  1. I $D(^PS(55,"CIMOCLI",CLINIC)) S PATIENT="" F S PATIENT=$O(^PS(55,"CIMOCLU",CLINIC,PATIENT)) Q:PATIENT="" D
  1. .K ^PS(55,PATIENT,"IV","CIMOI",CLINIC)
  1. K ^PS(55,"CIMOCLU",CLINIC),^PS(55,"CIMOCLI",CLINIC)
  1. I $D(^PS(53.1,"AD",CLINIC)) S PATIENT="" F S PATIENT=$O(^PS(53.1,"AD",CLINIC,PATIENT)) Q:PATIENT="" D
  1. .I $D(^PS(53.1,"CIMO",PATIENT,CLINIC)) K ^PS(53.1,"CIMO",PATIENT,CLINIC)
  1. Q
  1. ;
  1. CIMOU(PSGP,PSJDA55,PSCLINIC,PSJDA531) ;IMO UNIT DOSE FILE 55 CROSS REFERENCE SET
  1. N PSJCLINI,CLINFLG,PSJIVIEN,PSJSTAT
  1. I $G(PSJDA531)="" S PSJDA531=""
  1. S PSJSTAT=""
  1. I '$G(PSCLINIC) S PSCLINIC="",PSCLINIC=$$GET1^DIQ(55.06,+PSJDA55_","_PSGP_",",130,"I")
  1. Q:PSCLINIC=""
  1. S CLINFLG="",CLINFLG=$$GET1^DIQ(44,PSCLINIC,2802,"I") ;Only set xref if IMO clinic
  1. Q:'CLINFLG
  1. D GETS^DIQ(55.06,+PSJDA55_","_PSGP_",","34;131","I","PSJCLINI")
  1. I CLINFLG&($G(PSJCLINI(55.06,+PSJDA55_","_PSGP_",","131","I"))) D
  1. .S ^PS(55,"CIMOU",PSGP,PSCLINIC,PSJCLINI(55.06,+PSJDA55_","_PSGP_",","34","I"),PSGP,+PSJDA55)=""
  1. .S ^PS(55,"CIMOCLU",PSCLINIC,PSGP,+PSJDA55)=""
  1. S PSJIVIEN=$$GET1^DIQ(55.06,+PSJDA55_","_DFN_",",104) ;pick up ien from file 55 since PSJORD/PSGORD can't be trusted.
  1. S:PSJIVIEN="" PSJIVIEN=PSJDA531
  1. I $G(PSJIVIEN)]"",'$D(^PS(53.1,"CIMO",PSGP,PSCLINIC,PSJIVIEN)) S PSJIVIEN=PSJDA531 ;for edits, if no CIMO entry, use the passed in IEN. Non-edits will always have an entry.
  1. I +$G(PSJIVIEN) D KILL531(PSGP,PSCLINIC,+PSJIVIEN)
  1. Q
  1. ;
  1. CIMOI(DFN,PSJDA55,PSCLINIC,PSJDA531) ;IMO IV FILE 55 CROSS REFERENCE SET
  1. N PSJCLINI,CLINFLG,PSJIVIEN,PSJSTAT
  1. S PSJSTAT=""
  1. I '$G(PSCLINIC) S PSCLINIC=$$GET1^DIQ(55.01,+PSJDA55_","_DFN_",",136,"I")
  1. Q:PSCLINIC=""
  1. S CLINFLG="",CLINFLG=$$GET1^DIQ(44,PSCLINIC,2802,"I") ;Only set xref if IMO clinic
  1. Q:'CLINFLG
  1. D GETS^DIQ(55.01,+PSJDA55_","_DFN_",",".03","I","PSJCLINI")
  1. I $D(PSJCLINI(55.01,+PSJDA55_","_DFN_",",".03","I")) D
  1. .S ^PS(55,DFN,"IV","CIMOI",PSCLINIC,PSJCLINI(55.01,+PSJDA55_","_DFN_",",".03","I"),+PSJDA55)=""
  1. .S ^PS(55,"CIMOCLI",PSCLINIC,DFN,+PSJDA55)=""
  1. S PSJIVIEN=$$GET1^DIQ(55.01,+ON55_","_DFN_",",113) ;if there, pick up ien from file 55 since PSJORD/PSGORD can't be trusted.
  1. I PSJIVIEN=""&(+$G(PSJDA531)) S PSJIVIEN=PSJDA531
  1. ;I '$D(^PS(53.1,"CIMO",PSGP,PSCLINIC,PSJIVIEN)) S PSJIVIEN=PSJDA531 ;for edits, if no CIMO entry, use the passed in IEN. Non-edits will always have an entry.
  1. I +$G(PSJIVIEN) D KILL531(DFN,PSCLINIC,+PSJIVIEN)
  1. Q
  1. ;
  1. KILL531(PSJCLPAT,PSCLINIC,PSJIVIEN) ;
  1. I '$G(PSCLINIC) S PSCLINIC=$$GET1^DIQ(53.1,+PSJIVIEN_","_PSJCLPAT_",",113,"I")
  1. Q:PSCLINIC=""
  1. I $D(^PS(53.1,"CIMO",PSJCLPAT,PSCLINIC,+PSJIVIEN)) K ^PS(53.1,"CIMO",PSJCLPAT,PSCLINIC,+PSJIVIEN)
  1. Q
  1. ;
  1. GETCLN(PSGP,ORDER) ; Return Clinic IEN for a given patient/order combination
  1. I '$G(ORDER) Q ""
  1. N CLN S CLN=$S(ORDER["P":$G(^PS(53.1,+ORDER,"DSS")),ORDER["V":$G(^PS(55,PSGP,"IV",+ORDER,"DSS")),ORDER["U":$G(^PS(55,PSGP,5,+ORDER,8)),1:"")
  1. I 'CLN,(ORDER=+ORDER) D
  1. .I $D(^PS(53.1,"ACX",+ORDER)) N PSJORD S PSJORD=0 F S PSJORD=$O(^PS(53.1,"ACX",+ORDER,PSJORD)) Q:'PSJORD!$G(CLN) S CLN=$G(^PS(53.1,+PSJORD,"DSS"))
  1. .I $D(^PS(55,"ACX",+ORDER)) N ACX2,PSJORD S ACX2="" F S ACX2=$O(^PS(55,"ACX",+ORDER,ACX2)) Q:'ACX2!$G(CLN) S PSJORD=0 F S PSJORD=$O(^PS(55,"ACX",+ORDER,ACX2,PSJORD)) Q:'PSJORD!$G(CLN) D
  1. ..S CLN=$S(PSJORD["P":$G(^PS(53.1,+PSJORD,"DSS")),PSJORD["V":$G(^PS(55,PSGP,"IV",+PSJORD,"DSS")),ORDER["U":$G(^PS(55,PSGP,5,+PSJORD,8)),1:"")
  1. Q +CLN
  1. ;
  1. CHECK() ;SET CONDITION FOR CIMOU XREF IN FILE 55
  1. ;UNIT DOSE - X2(1)=PATIENT, X2(2)=CLINIC, X2(3)=STOP DATE
  1. N PSJAPPTD,X S X=0
  1. Q:'$$IMOCHK(X2(2)) 0 ;don't set clinic x-refs where clinic isn't marked as IMO.
  1. S PSJAPPTD=$$GET1^DIQ(55.06,DA_","_X2(1)_",",131,"I")
  1. S:PSJAPPTD'="" X=1
  1. Q X
  1. ;
  1. CHECK2() ;SET CONDITION FOR CIMOI XREF IN FILE 55
  1. ;IV - DA(1)=PATIENT, X2(1)=CLINIC, X2(2)=STOP DATE, DA=SUBFILE IEN
  1. N PSJAPPTD,X S X=0
  1. Q:'$$IMOCHK(X2(1)) 0 ;don't set clinic x-refs where clinic isn't marked as IMO.
  1. S PSJAPPTD=$$GET1^DIQ(55.01,DA_","_DA(1)_",",139,"I")
  1. S:PSJAPPTD'="" X=1
  1. Q X
  1. ;
  1. IMOCHK(PSJIMOCL) ;determine if clinic is an IMO clinic; returns 1 if IMO or 0 not IMO
  1. Q:'$G(PSJIMOCL) 0
  1. N PSJCFLAG
  1. S PSJCFLAG=$$GET1^DIQ(44,PSJIMOCL,2802,"I")
  1. Q PSJCFLAG
  1. ;
  1. CHECK3() ;SET CONDITION FOR CIMO XREF IN FILE 53.1
  1. ; DA=IEN, X(1)=PATIENT, X(2)=CLINIC
  1. N PSJCFLAG,PSJAPPTD,X,PSJTYPE,PSJUTMP S X=0
  1. Q:'$$IMOCHK(X2(2)) 0 ;don't set clinic x-refs where clinic isn't marked as IMO.
  1. D GETS^DIQ(53.1,DA,"28;126","I","PSJUTMP")
  1. S X=0,(PSJAPPTD,PSJTYPE)=""
  1. S:$D(PSJUTMP(53.1,DA_",",126,"I")) PSJAPPTD=PSJUTMP(53.1,DA_",",126,"I")
  1. S:$D(PSJUTMP(53.1,DA_",",28,"I")) PSJTYPE=PSJUTMP(53.1,DA_",",28,"I")
  1. Q:PSJTYPE'="P"&(PSJTYPE'="N") 0 ;only pending and non-verified orders are allowed in the xref
  1. S:PSJAPPTD'="" X=1
  1. Q X
  1. ;
  1. TEST ;KILL ALL IMO CROSS REFERENCES FOR A PARTICULAR CLINIC AND PATIENT
  1. N PSJTESCL,PSJTESPA
  1. TEST2 ;
  1. K DIC S DIC="^PS(53.46,",DIC(0)="AELMQ",DIC("A")="Select CLINIC: ",DLAYGO=53.46 D ^DIC K DIC G DONE:Y=""!(Y<1)
  1. S PSJTESCL=$P(Y,"^",2)
  1. K DIC,PSGP,Y W !!,"Select "_$S($D(PSGDICA):PSGDICA_" ",1:"")_"PATIENT: " R X:DTIME S:'$T X="^" W:'$T $C(7) I "^"[X S (Y,PSGP)=-1 S QFLG=1 G DONE
  1. K DIC S DIC="^DPT(",DIC("W")="D DPT^PSJDPT",DIC(0)="QEMZ" D ^DPTLK K DIC
  1. S PSJTESPA=$P(Y,"^")
  1. ;
  1. K ^PS(55,PSJTESPA,"IV","CIMOI",PSJTESCL)
  1. K ^PS(55,"CIMOCLI",PSJTESCL)
  1. K ^PS(55,"CIMOU",PSJTESPA,PSJTESCL)
  1. K ^PS(55,"CIMOCLU",PSJTESCL)
  1. K ^PS(53.1,"CIMO",PSJTESPA,PSJTESCL)
  1. W !,"DELETED",!
  1. DONE ;
  1. Q
  1. ;
  1. CLEAN(DFN) ;Delete old entriers from clinic order xref; CALLED WHEN USER EXITS PATIENT IN IOE
  1. ;----get top of the range of dates stored for each clinic
  1. N PSCLINIC,PSTYPE,ENDDATE,RXDATE,CLNDAYS,CLNARRY,PSJIEN
  1. S (PSTYPE,PSCLINIC,CLNDAYS,CLNARRY)=""
  1. F PSTYPE="CIMOCLU","CIMOCLI" F S PSCLINIC=$O(^PS(55,PSTYPE,PSCLINIC)) Q:PSCLINIC="" D
  1. .S CLNDAYS=$$GET1^DIQ(53.46,PSCLINIC,6) S:CLNDAYS="" CLNDAYS=30 ;default to 30 days if not defined
  1. .D NOW^%DTC S X1=%,X2=-CLNDAYS D C^%DTC S CLNARRY($S(PSTYPE="CIMOCLU":"U",1:"V"),PSCLINIC)=X
  1. ;----kill x-refs for all unit dose entries older than the clinic begin date
  1. I $D(CLNARRY("U")) S PSCLINIC="" F S PSCLINIC=$O(CLNARRY("U",PSCLINIC)) Q:PSCLINIC="" D
  1. .S (RXDATE,ENDDATE)="",ENDDATE=CLNARRY("U",PSCLINIC)
  1. .F S RXDATE=$O(^PS(55,"CIMOU",DFN,PSCLINIC,RXDATE)) Q:RXDATE="" I RXDATE<ENDDATE K ^PS(55,"CIMOU",DFN,PSCLINIC,RXDATE) D
  1. ..S PSJIEN="" F S PSJIEN=$O(^PS(55,"CIMOU",DFN,PSCLINIC,RXDATE,DFN,PSJIEN)) Q:PSJIEN="" K ^PS(55,"CIMOU",DFN,PSCLINIC,RXDATE,DFN,PSJIEN)
  1. ;----kill x-refs for all IV entries older than the clinic begin date
  1. I $D(CLNARRY("V")) S PSCLINIC="" F S PSCLINIC=$O(CLNARRY("V",PSCLINIC)) Q:PSCLINIC="" D
  1. .S (RXDATE,ENDDATE)="",ENDDATE=CLNARRY("V",PSCLINIC)
  1. .F S RXDATE=$O(^PS(55,DFN,"IV","CIMOI",PSCLINIC,RXDATE)) Q:RXDATE="" I RXDATE<ENDDATE K ^PS(55,DFN,"IV","CIMOI",PSCLINIC,RXDATE) D
  1. ..S PSJIEN="" F S PSJIEN=$O(^PS(55,DFN,"IV","CIMOI",PSCLINIC,RXDATE,PSJIEN)) Q:PSJIEN="" K ^PS(55,DFN,"IV","CIMOI",PSCLINIC,RXDATE,PSJIEN)
  1. Q
  1. ;