source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVHYP.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1PSIVHYP ;BIR/RGY-CALCULATE AND PRINT HYPER ORDERS ;16 DEC 97 / 1:39 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**58,96**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191
5 ; Reference to ^PS(52.6 is supported by DBIA# 1231
6 ; Reference to ^PS(52.7 is supported by DBIA# 2173
7 ; Reference to ^PS(50.4 is supported by DBIA 2175
8 ;
9 K HYPL,HYPA,PSIVPRT S TVOL=0 F Z=52.6,52.7 F DRG=0:0 S DRG=$O(^PS(55,DFN,"IV",+ON,$S(Z=52.6:"AD",1:"SOL"),DRG)) Q:'DRG S DRG=DRG_"^"_^(DRG,0) S:$P(DRG,"^",4)="" $P(DRG,"^",4)="ALL" D DRG
10 S TVOL=TVOL+.5\1 K EL,DRG,NAD,Z Q
11DRG ;
12 I Z=52.7 S TVOL=TVOL+$P(DRG,"^",3)
13 NEW ZZ S ZZ=$S(Z=52.6:"AD",1:"SOL")
14 S NAD=$S('$P(DRG,"^",2):"*",$D(^PS(Z,$P(DRG,"^",2),0)):^(0),1:"*")
15 I NAD="*" S HYPL(+Z,"*","ALL")=".0001 ***"
16 I Z=52.6,$S('$D(^PS(52.6,$P(DRG,"^",2),2,0)):1,$P(^(0),"^",4)<1:1,1:0) D ADD Q
17 F EL=0:0 S EL=$O(^PS(Z,$P(DRG,"^",2),2,EL)) Q:'EL S EL=EL_"^"_^(EL,0) D EL
18 Q
19EL ;
20 I $S($P(EL,"^",2)="":1,'$D(^PS(50.4,$P(EL,"^",2),0)):1,1:0) S HYPL(Z,"*","ALL")=".0001 ***"_U_$P(EL,U,2) Q
21 I $P($P($P(EL,"^",3),"/")," ",2)="" S HYPL(50.4,$P(EL,"^",2),"ALL")=".0001 ***"_U_$P(EL,U,2) Q
22 S ELT=$S($P(NAD,"^",10)!(Z=52.7):$P(DRG,"^",3)/$S(Z=52.7:1,1:$P(NAD,"^",10))*$P(EL,"^",3),1:0)
23 S HYPL(50.4,$P(EL,"^",2),$P(DRG,"^",4))=$S($D(HYPL(50.4,$P(EL,"^",2),$P(DRG,"^",4))):HYPL(50.4,$P(EL,"^",2),$P(DRG,"^",4)),1:0)+ELT_" "_$P($P($P(EL,"^",3),"/")," ",2)_U_$P(EL,U,2)
24 ;S HYPA(50.4,$P(EL,"^",2),$P(DRG,"^",4))=Z_"^"_+DRG_ZZ
25 S HYPLRPT($P(EL,U,2),ZZ,+DRG)=""
26 K ELT Q
27ADD S:'$D(HYPL(+Z,+DRG,$P(DRG,"^",4))) HYPL(+Z,+DRG,$P(DRG,"^",4))=0 S HYPL(+Z,+DRG,$P(DRG,"^",4))=HYPL(+Z,+DRG,$P(DRG,"^",4))+$P(DRG,"^",3)_" "_$P($P(DRG,"^",3)," ",2)_U_+DRG_ZZ Q
Note: See TracBrowser for help on using the repository browser.