- PSJUTL2 ;BIR/LDT - MISC UTILITIES FOR INPATIENT MEDICATIONS ;18 Aug 98 / 2:48 PM
- ;;5.0; INPATIENT MEDICATIONS ;**63,58,81,105,110,111**;16 DEC 97
- ;
- ; Reference to ^PS(55 is supported by DBIA# 2191.
- ; Reference to ^PSBAPIPM is supported by DBIA# 3564.
- ; Reference to ^PSB(53.79 is supported by DBIA 3370.
- ;
- BCMALG(PSJX,PSJY) ;Returns BCMA Last Action formatted for printing
- N PSJLAST S PSJLACT=""
- I PSJY["V" Q:$G(^PS(55,PSJX,"IV",+PSJY,.2))="" ""
- S PSJLAST=$$EN^PSBAPIPM(PSJX,PSJY)
- I PSJLAST]"" S PSJLACT="BCMA ORDER LAST ACTION: "_$$ENDTC1^PSGMI($P(PSJLAST,"^",2))_" "_$$EXTERNAL^DILFD(53.79,.09,"",$P(PSJLAST,"^",3))
- I PSJLAST="" D PREV
- Q PSJLACT
- ;
- PREV ;If the original order has no administration data logged against it then check to see if there is data for the previous order.
- N PREON
- 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))
- I PREON]"" S PSJLAST=$$EN^PSBAPIPM(PSJX,PREON)
- I PSJLAST]"" S PSJLACT="BCMA ORDER LAST ACTION: "_$$ENDTC1^PSGMI($P(PSJLAST,"^",2))_" "_$$EXTERNAL^DILFD(53.79,.09,"",$P(PSJLAST,"^",3))_"*"
- Q
- ;
- DATE() ;Returns date in fileman format with a time in hours and minutes.
- S PSGDT="" N X,TIM
- D NOW^%DTC D
- .I $L(%)=12 S X=% Q
- .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
- .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
- 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
- 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)
- Q PSGDT
- ;
- DATE2(PSJDT) ;Returns date in fileman format with a time in hours and minutes
- Q:'$G(PSJDT) ""
- N X,TIM D
- .I $L(PSJDT)=12 S X=PSJDT Q
- .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
- .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
- 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
- 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)
- Q PSJDT
- ;
- RNEWOK(DAD,PSJDFN) ;Returns 1 or 0 if all in complex order series are active.
- N F,I,II,Y,NODE0,STAT S Y=1,I=0,II=""
- 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
- .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
- .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
- ..S Y='$$EXPIRED^PSGOER(PSJDFN,II)
- Q Y
- PSJUTL2 ;BIR/LDT - MISC UTILITIES FOR INPATIENT MEDICATIONS ;18 Aug 98 / 2:48 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**63,58,81,105,110,111**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA# 2191.
- +4 ; Reference to ^PSBAPIPM is supported by DBIA# 3564.
- +5 ; Reference to ^PSB(53.79 is supported by DBIA 3370.
- +6 ;
- BCMALG(PSJX,PSJY) ;Returns BCMA Last Action formatted for printing
- +1 NEW PSJLAST
- SET PSJLACT=""
- +2 IF PSJY["V"
- IF $GET(^PS(55,PSJX,"IV",+PSJY,.2))=""
- QUIT ""
- +3 SET PSJLAST=$$EN^PSBAPIPM(PSJX,PSJY)
- +4 IF PSJLAST]""
- SET PSJLACT="BCMA ORDER LAST ACTION: "_$$ENDTC1^PSGMI($PIECE(PSJLAST,"^",2))_" "_$$EXTERNAL^DILFD(53.79,.09,"",$PIECE(PSJLAST,"^",3))
- +5 IF PSJLAST=""
- DO PREV
- +6 QUIT PSJLACT
- +7 ;
- PREV ;If the original order has no administration data logged against it then check to see if there is data for the previous order.
- +1 NEW PREON
- +2 SET PREON=$SELECT(PSJY["V":$PIECE($GET(^PS(55,PSJX,"IV",+PSJY,2)),"^",5),PSJY["U":$PIECE($GET(^PS(55,PSJX,5,+PSJY,0)),"^",25),1:$PIECE($GET(^PS(53.1,+PSJY,0)),"^",25))
- +3 IF PREON]""
- SET PSJLAST=$$EN^PSBAPIPM(PSJX,PREON)
- +4 IF PSJLAST]""
- SET PSJLACT="BCMA ORDER LAST ACTION: "_$$ENDTC1^PSGMI($PIECE(PSJLAST,"^",2))_" "_$$EXTERNAL^DILFD(53.79,.09,"",$PIECE(PSJLAST,"^",3))_"*"
- +5 QUIT
- +6 ;
- DATE() ;Returns date in fileman format with a time in hours and minutes.
- +1 SET PSGDT=""
- NEW X,TIM
- +2 DO NOW^%DTC
- Begin DoDot:1
- +3 IF $LENGTH(%)=12
- SET X=%
- QUIT
- +4 IF $LENGTH(%)=14
- SET X=$EXTRACT(%,13,14)
- IF X>29
- SET X=$EXTRACT(%,1,12)_5
- IF X'>29
- SET X=$EXTRACT(%,1,12)_1
- QUIT
- +5 IF $LENGTH(%)=13
- SET X=$EXTRACT(%,13)_0
- IF X>29
- SET X=$EXTRACT(%,1,12)_5
- IF X'>29
- SET X=$EXTRACT(%,1,12)_1
- QUIT
- End DoDot:1
- +6 SET PSGDT=$SELECT($GET(X)]"":+$FNUMBER($GET(X),"",4),1:PSJDT)
- IF '$PIECE(PSGDT,".",2)
- SET PSGDT=$$FMADD^XLFDT(PSGDT,-1,0,0,0)_.24
- +7 SET TIM=$PIECE(PSGDT,".",2)
- IF $EXTRACT(TIM,3)=6
- SET TIM=$EXTRACT(TIM,1,2)+1
- SET PSGDT=$PIECE(PSGDT,".")_"."_$TRANSLATE($JUSTIFY(TIM,2)," ",0)
- +8 QUIT PSGDT
- +9 ;
- DATE2(PSJDT) ;Returns date in fileman format with a time in hours and minutes
- +1 IF '$GET(PSJDT)
- QUIT ""
- +2 NEW X,TIM
- Begin DoDot:1
- +3 IF $LENGTH(PSJDT)=12
- SET X=PSJDT
- QUIT
- +4 IF $LENGTH(PSJDT)>13
- SET X=$EXTRACT(PSJDT,13,14)
- IF X>29
- SET X=$EXTRACT(PSJDT,1,12)_5
- IF X'>29
- SET X=$EXTRACT(PSJDT,1,12)_1
- QUIT
- +5 IF $LENGTH(PSJDT)=13
- SET X=$EXTRACT(PSJDT,13)_0
- IF X>29
- SET X=$EXTRACT(PSJDT,1,12)_5
- IF X'>29
- SET X=$EXTRACT(PSJDT,1,12)_1
- QUIT
- End DoDot:1
- +6 SET PSJDT=$SELECT($GET(X)]"":+$FNUMBER($GET(X),"",4),1:PSJDT)
- IF '$PIECE(PSJDT,".",2)
- SET PSJDT=$$FMADD^XLFDT(PSJDT,-1,0,0,0)_.24
- +7 SET TIM=$PIECE(PSJDT,".",2)
- IF $EXTRACT(TIM,3)=6
- SET TIM=$EXTRACT(TIM,1,2)+1
- SET PSJDT=$PIECE(PSJDT,".")_"."_$TRANSLATE($JUSTIFY(TIM,2)," ",0)
- +8 QUIT PSJDT
- +9 ;
- RNEWOK(DAD,PSJDFN) ;Returns 1 or 0 if all in complex order series are active.
- +1 NEW F,I,II,Y,NODE0,STAT
- SET Y=1
- SET I=0
- SET II=""
- +2 FOR
- SET I=$ORDER(^PS(55,"ACX",DAD,I))
- IF 'I
- QUIT
- FOR
- SET II=$ORDER(^PS(55,"ACX",DAD,I,II))
- IF II=""
- QUIT
- Begin DoDot:1
- +3 SET F=$SELECT(II["V":"^PS(55,"_PSJDFN_",""IV"","_+II,II["U":"^PS(55,"_PSJDFN_",5,"_+II,1:"")
- IF F=""
- SET Y=0
- IF Y=0
- QUIT
- +4 SET NODE0=$GET(@(F_",0)"))
- SET STAT=$SELECT(II["V":($PIECE(NODE0,"^",17)),1:($PIECE(NODE0,"^",9)))
- IF STAT'="A"
- SET Y=0
- IF STAT="E"
- Begin DoDot:2
- +5 SET Y='$$EXPIRED^PSGOER(PSJDFN,II)
- End DoDot:2
- End DoDot:1
- IF Y=0
- QUIT
- +6 QUIT Y
