| 1 | PSJDCU ;BIR/JLC-DATE CALCULATION UTILITY ;09/07/00
 | 
|---|
| 2 |  ;;5.0; INPATIENT MEDICATIONS ;**47,63,66,69,58,95,127,133**;16 DEC 97
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; Reference to ^PS(55 is supported by DBIA# 2191
 | 
|---|
| 5 |  ; Reference to ^PS(59.7 is supported by DBIA# 2181
 | 
|---|
| 6 |  ; Reference to ^%DTC is supported by DBIA# 10000
 | 
|---|
| 7 |  ; Reference to ^PSBAPIPM is supported by DBIA# 3564
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 | DSTART(PSJDFN,PSJORD) ;calculate default start date
 | 
|---|
| 10 |  I $G(PSJSPEED) Q ""
 | 
|---|
| 11 |  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)
 | 
|---|
| 12 |  N LAST,LASTH,NOW,FREQ,X,Y,%H,%T,NEW,SCH,ADM,STOP
 | 
|---|
| 13 |  S Y=$$EN^PSBAPIPM(PSJDFN,PSJORD)
 | 
|---|
| 14 |  I Y=""!("GR"'[$P(Y,U,3)) Q ""
 | 
|---|
| 15 |  S (SCH,X)=$P(Y,U) D H^%DTC S LAST=%H*86400+%T,LASTH=%H_","_%T
 | 
|---|
| 16 |  D NOW^%DTC S NOW=%
 | 
|---|
| 17 |  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)
 | 
|---|
| 18 |  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)
 | 
|---|
| 19 |  I FREQ="O" Q ""
 | 
|---|
| 20 |  I ADM="" S SCH="",X=$P(Y,U,2) D H^%DTC S LAST=%H*86400+%T
 | 
|---|
| 21 |  S FREQ=$S(FREQ="D":1440,FREQ="O":0,1:FREQ)*60
 | 
|---|
| 22 |  S NEW=LAST+FREQ+$S(SCH]"":0,1:3599),%H=NEW\86400_","_(NEW#86400)
 | 
|---|
| 23 |  I $P(%H,",",2)<3600 S %H=$S(+%H=+LASTH:+%H,1:%H-1)_",86400"
 | 
|---|
| 24 |  D YMD^%DTC
 | 
|---|
| 25 |  S NEW=X_+$E(%,1,3)
 | 
|---|
| 26 |  I NOW>NEW Q ""
 | 
|---|
| 27 |  I $G(PSJREN) I ADM]"",NEW>STOP S NEW=STOP
 | 
|---|
| 28 |  I ADM]"",NEW>STOP Q ""
 | 
|---|
| 29 |  Q NEW
 | 
|---|
| 30 | ENOSD(PSJWP,PSJSD,DFN) ;calculate one-time stop date from ward/system parameters
 | 
|---|
| 31 |  ;Input:  PSJWP - Inpatient Ward Parameters for the patient's ward
 | 
|---|
| 32 |  ;        PSJSD - Start date for the order
 | 
|---|
| 33 |  ;        DFN   - Internal entry number for the patient
 | 
|---|
| 34 |  N PSJOP,PSJST,VAIP,%,I,X,Y,W,Z,E
 | 
|---|
| 35 |  S PSJWP=$G(PSJWP),PSJSD=$G(PSJSD),DFN=$G(DFN)
 | 
|---|
| 36 |  D NOW^%DTC I PSJSD="" S PSJSD=%
 | 
|---|
| 37 |  I DFN]"" S VAIP("D")=% D IN5^VADPT I VAIP(5)="" S PSJWP=""
 | 
|---|
| 38 |  S PSJOP=$P(PSJWP,"^",28) I PSJOP="" S PSJOP=$P($G(^PS(59.7,1,26)),"^",6)
 | 
|---|
| 39 |  I PSJOP="" Q ""
 | 
|---|
| 40 |  S PSJST=$$FMADD^XLFDT(PSJSD,PSJOP)  Q PSJST
 | 
|---|