PSJDCU ;BIR/JLC-DATE CALCULATION UTILITY ;09/07/00
;;5.0; INPATIENT MEDICATIONS ;**47,63,66,69,58,95,127,133**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA# 2191
; Reference to ^PS(59.7 is supported by DBIA# 2181
; Reference to ^%DTC is supported by DBIA# 10000
; Reference to ^PSBAPIPM is supported by DBIA# 3564
;
DSTART(PSJDFN,PSJORD) ;calculate default start date
I $G(PSJSPEED) Q ""
I $G(PSJORD)["U",$G(PSGORD)["P" I $P($G(^PS(53.1,+PSGORD,0)),"^",24,25)="R^"_PSJORD Q $P($G(^PS(55,+$G(PSJDFN),5,+PSJORD,2)),"",2)
N LAST,LASTH,NOW,FREQ,X,Y,%H,%T,NEW,SCH,ADM,STOP
S Y=$$EN^PSBAPIPM(PSJDFN,PSJORD)
I Y=""!("GR"'[$P(Y,U,3)) Q ""
S (SCH,X)=$P(Y,U) D H^%DTC S LAST=%H*86400+%T,LASTH=%H_","_%T
D NOW^%DTC S NOW=%
I PSJORD["U" S X=^PS(55,PSJDFN,5,+PSJORD,2),STOP=$P(X,U,4),ADM=$P(X,U,5),FREQ=$P(X,U,6)
I PSJORD["V" S X=^PS(55,PSJDFN,"IV",+PSJORD,0),STOP=$P(X,U,3),ADM=$P(X,U,11),FREQ=$P(X,U,15)
I FREQ="O" Q ""
I ADM="" S SCH="",X=$P(Y,U,2) D H^%DTC S LAST=%H*86400+%T
S FREQ=$S(FREQ="D":1440,FREQ="O":0,1:FREQ)*60
S NEW=LAST+FREQ+$S(SCH]"":0,1:3599),%H=NEW\86400_","_(NEW#86400)
I $P(%H,",",2)<3600 S %H=$S(+%H=+LASTH:+%H,1:%H-1)_",86400"
D YMD^%DTC
S NEW=X_+$E(%,1,3)
I NOW>NEW Q ""
I $G(PSJREN) I ADM]"",NEW>STOP S NEW=STOP
I ADM]"",NEW>STOP Q ""
Q NEW
ENOSD(PSJWP,PSJSD,DFN) ;calculate one-time stop date from ward/system parameters
;Input: PSJWP - Inpatient Ward Parameters for the patient's ward
; PSJSD - Start date for the order
; DFN - Internal entry number for the patient
N PSJOP,PSJST,VAIP,%,I,X,Y,W,Z,E
S PSJWP=$G(PSJWP),PSJSD=$G(PSJSD),DFN=$G(DFN)
D NOW^%DTC I PSJSD="" S PSJSD=%
I DFN]"" S VAIP("D")=% D IN5^VADPT I VAIP(5)="" S PSJWP=""
S PSJOP=$P(PSJWP,"^",28) I PSJOP="" S PSJOP=$P($G(^PS(59.7,1,26)),"^",6)
I PSJOP="" Q ""
S PSJST=$$FMADD^XLFDT(PSJSD,PSJOP) Q PSJST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJDCU 1888 printed Oct 16, 2024@18:07:22 Page 2
PSJDCU ;BIR/JLC-DATE CALCULATION UTILITY ;09/07/00
+1 ;;5.0; INPATIENT MEDICATIONS ;**47,63,66,69,58,95,127,133**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191
+4 ; Reference to ^PS(59.7 is supported by DBIA# 2181
+5 ; Reference to ^%DTC is supported by DBIA# 10000
+6 ; Reference to ^PSBAPIPM is supported by DBIA# 3564
+7 ;
DSTART(PSJDFN,PSJORD) ;calculate default start date
+1 IF $GET(PSJSPEED)
QUIT ""
+2 IF $GET(PSJORD)["U"
IF $GET(PSGORD)["P"
IF $PIECE($GET(^PS(53.1,+PSGORD,0)),"^",24,25)="R^"_PSJORD
QUIT $PIECE($GET(^PS(55,+$GET(PSJDFN),5,+PSJORD,2)),"",2)
+3 NEW LAST,LASTH,NOW,FREQ,X,Y,%H,%T,NEW,SCH,ADM,STOP
+4 SET Y=$$EN^PSBAPIPM(PSJDFN,PSJORD)
+5 IF Y=""!("GR"'[$PIECE(Y,U,3))
QUIT ""
+6 SET (SCH,X)=$PIECE(Y,U)
DO H^%DTC
SET LAST=%H*86400+%T
SET LASTH=%H_","_%T
+7 DO NOW^%DTC
SET NOW=%
+8 IF PSJORD["U"
SET X=^PS(55,PSJDFN,5,+PSJORD,2)
SET STOP=$PIECE(X,U,4)
SET ADM=$PIECE(X,U,5)
SET FREQ=$PIECE(X,U,6)
+9 IF PSJORD["V"
SET X=^PS(55,PSJDFN,"IV",+PSJORD,0)
SET STOP=$PIECE(X,U,3)
SET ADM=$PIECE(X,U,11)
SET FREQ=$PIECE(X,U,15)
+10 IF FREQ="O"
QUIT ""
+11 IF ADM=""
SET SCH=""
SET X=$PIECE(Y,U,2)
DO H^%DTC
SET LAST=%H*86400+%T
+12 SET FREQ=$SELECT(FREQ="D":1440,FREQ="O":0,1:FREQ)*60
+13 SET NEW=LAST+FREQ+$SELECT(SCH]"":0,1:3599)
SET %H=NEW\86400_","_(NEW#86400)
+14 IF $PIECE(%H,",",2)<3600
SET %H=$SELECT(+%H=+LASTH:+%H,1:%H-1)_",86400"
+15 DO YMD^%DTC
+16 SET NEW=X_+$EXTRACT(%,1,3)
+17 IF NOW>NEW
QUIT ""
+18 IF $GET(PSJREN)
IF ADM]""
IF NEW>STOP
SET NEW=STOP
+19 IF ADM]""
IF NEW>STOP
QUIT ""
+20 QUIT NEW
ENOSD(PSJWP,PSJSD,DFN) ;calculate one-time stop date from ward/system parameters
+1 ;Input: PSJWP - Inpatient Ward Parameters for the patient's ward
+2 ; PSJSD - Start date for the order
+3 ; DFN - Internal entry number for the patient
+4 NEW PSJOP,PSJST,VAIP,%,I,X,Y,W,Z,E
+5 SET PSJWP=$GET(PSJWP)
SET PSJSD=$GET(PSJSD)
SET DFN=$GET(DFN)
+6 DO NOW^%DTC
IF PSJSD=""
SET PSJSD=%
+7 IF DFN]""
SET VAIP("D")=%
DO IN5^VADPT
IF VAIP(5)=""
SET PSJWP=""
+8 SET PSJOP=$PIECE(PSJWP,"^",28)
IF PSJOP=""
SET PSJOP=$PIECE($GET(^PS(59.7,1,26)),"^",6)
+9 IF PSJOP=""
QUIT ""
+10 SET PSJST=$$FMADD^XLFDT(PSJSD,PSJOP)
QUIT PSJST
