| 1 | PSJUTL2  ;BIR/LDT - MISC UTILITIES FOR INPATIENT MEDICATIONS ;18 Aug 98 / 2:48 PM | 
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**63,58,81,105,110,111**;16 DEC 97 | 
|---|
| 3 | ; | 
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA# 2191. | 
|---|
| 5 | ; Reference to ^PSBAPIPM is supported by DBIA# 3564. | 
|---|
| 6 | ; Reference to ^PSB(53.79 is supported by DBIA 3370. | 
|---|
| 7 | ; | 
|---|
| 8 | BCMALG(PSJX,PSJY)     ;Returns BCMA Last Action formatted for printing | 
|---|
| 9 | N PSJLAST S PSJLACT="" | 
|---|
| 10 | I PSJY["V" Q:$G(^PS(55,PSJX,"IV",+PSJY,.2))="" "" | 
|---|
| 11 | S PSJLAST=$$EN^PSBAPIPM(PSJX,PSJY) | 
|---|
| 12 | I PSJLAST]"" S PSJLACT="BCMA ORDER LAST ACTION: "_$$ENDTC1^PSGMI($P(PSJLAST,"^",2))_" "_$$EXTERNAL^DILFD(53.79,.09,"",$P(PSJLAST,"^",3)) | 
|---|
| 13 | I PSJLAST="" D PREV | 
|---|
| 14 | Q PSJLACT | 
|---|
| 15 | ; | 
|---|
| 16 | PREV ;If the original order has no administration data logged against it then check to see if there is data for the previous order. | 
|---|
| 17 | N PREON | 
|---|
| 18 | S PREON=$S(PSJY["V":$P($G(^PS(55,PSJX,"IV",+PSJY,2)),"^",5),PSJY["U":$P($G(^PS(55,PSJX,5,+PSJY,0)),"^",25),1:$P($G(^PS(53.1,+PSJY,0)),"^",25)) | 
|---|
| 19 | I PREON]"" S PSJLAST=$$EN^PSBAPIPM(PSJX,PREON) | 
|---|
| 20 | I PSJLAST]"" S PSJLACT="BCMA ORDER LAST ACTION: "_$$ENDTC1^PSGMI($P(PSJLAST,"^",2))_" "_$$EXTERNAL^DILFD(53.79,.09,"",$P(PSJLAST,"^",3))_"*" | 
|---|
| 21 | Q | 
|---|
| 22 | ; | 
|---|
| 23 | DATE() ;Returns date in fileman format with a time in hours and minutes. | 
|---|
| 24 | S PSGDT="" N X,TIM | 
|---|
| 25 | D NOW^%DTC D | 
|---|
| 26 | .I $L(%)=12 S X=% Q | 
|---|
| 27 | .I $L(%)=14 S X=$E(%,13,14) S:X>29 X=$E(%,1,12)_5 S:X'>29 X=$E(%,1,12)_1 Q | 
|---|
| 28 | .I $L(%)=13 S X=$E(%,13)_0 S:X>29 X=$E(%,1,12)_5 S:X'>29 X=$E(%,1,12)_1 Q | 
|---|
| 29 | S PSGDT=$S($G(X)]"":+$FN($G(X),"",4),1:PSJDT) I '$P(PSGDT,".",2) S PSGDT=$$FMADD^XLFDT(PSGDT,-1,0,0,0)_.24 | 
|---|
| 30 | S TIM=$P(PSGDT,".",2) I $E(TIM,3)=6 S TIM=$E(TIM,1,2)+1,PSGDT=$P(PSGDT,".")_"."_$TR($J(TIM,2)," ",0) | 
|---|
| 31 | Q PSGDT | 
|---|
| 32 | ; | 
|---|
| 33 | DATE2(PSJDT) ;Returns date in fileman format with a time in hours and minutes | 
|---|
| 34 | Q:'$G(PSJDT) "" | 
|---|
| 35 | N X,TIM D | 
|---|
| 36 | .I $L(PSJDT)=12 S X=PSJDT Q | 
|---|
| 37 | .I $L(PSJDT)>13 S X=$E(PSJDT,13,14) S:X>29 X=$E(PSJDT,1,12)_5 S:X'>29 X=$E(PSJDT,1,12)_1 Q | 
|---|
| 38 | .I $L(PSJDT)=13 S X=$E(PSJDT,13)_0 S:X>29 X=$E(PSJDT,1,12)_5 S:X'>29 X=$E(PSJDT,1,12)_1 Q | 
|---|
| 39 | S PSJDT=$S($G(X)]"":+$FN($G(X),"",4),1:PSJDT) I '$P(PSJDT,".",2) S PSJDT=$$FMADD^XLFDT(PSJDT,-1,0,0,0)_.24 | 
|---|
| 40 | S TIM=$P(PSJDT,".",2) I $E(TIM,3)=6 S TIM=$E(TIM,1,2)+1,PSJDT=$P(PSJDT,".")_"."_$TR($J(TIM,2)," ",0) | 
|---|
| 41 | Q PSJDT | 
|---|
| 42 | ; | 
|---|
| 43 | RNEWOK(DAD,PSJDFN) ;Returns 1 or 0 if all in complex order series are active. | 
|---|
| 44 | N F,I,II,Y,NODE0,STAT S Y=1,I=0,II="" | 
|---|
| 45 | F  S I=$O(^PS(55,"ACX",DAD,I)) Q:'I  F  S II=$O(^PS(55,"ACX",DAD,I,II)) Q:II=""  D  Q:Y=0 | 
|---|
| 46 | .S F=$S(II["V":"^PS(55,"_PSJDFN_",""IV"","_+II,II["U":"^PS(55,"_PSJDFN_",5,"_+II,1:"") S:F="" Y=0 Q:Y=0 | 
|---|
| 47 | .S NODE0=$G(@(F_",0)")),STAT=$S(II["V":($P(NODE0,"^",17)),1:($P(NODE0,"^",9))) I STAT'="A" S Y=0 I STAT="E" D | 
|---|
| 48 | ..S Y='$$EXPIRED^PSGOER(PSJDFN,II) | 
|---|
| 49 | Q Y | 
|---|