source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJUTL2.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1PSJUTL2 ;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 ;
8BCMALG(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 ;
16PREV ;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 ;
23DATE() ;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 ;
33DATE2(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 ;
43RNEWOK(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
Note: See TracBrowser for help on using the repository browser.