PSJDCU.m

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

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