source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGPRVR.m@ 1240

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PSGPRVR ;BIR/CML3-PROVIDER COST TOTALS ;12 DEC 97 / 9:54 AM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3 D ENCV^PSGSETU I '$D(XQUIT) S HLP="PROVIDER" D ENDTS^PSGAMS I SD,FD D QUES I $S(PSGPRVRF="^":0,1:PSGPRVRP'="^") S RTN="PRVR" D EN3^PSGTI I 'POP,'$D(IO("Q")) D ENQ D:IO'=IO(0)!($E(IOST)'="C") ^%ZISC
4 ;
5DONE ;
6 D ENKV^PSGSETU K DRG,DRGN,FD,ND,NF,NU,P,PRN,PR,PSGPRVRF,PSGPRVRP,PG,RTN,SD,ST,STOP,STRT,W,WN,HLP Q
7 ;
8ENQ ;
9 K ^TMP("PSG",$J)
10 F ST=SD:0 S ST=$O(^PS(57.6,ST)) Q:'ST!(ST>FD) S W=0 F S W=$O(^PS(57.6,ST,1,W)) Q:'W S PR=0 F S PR=$O(^PS(57.6,ST,1,W,1,PR)) Q:'PR I $S('PSGPRVRF:1,1:$D(PSGPRVRF(PR))) D DRG
11 S PR="" F Q=0:0 S PR=$O(^TMP("PSG",$J,PR)) Q:PR="" S DRG="" F Q=0:0 S DRG=$O(^TMP("PSG",$J,PR,DRG)) Q:DRG="" I '^(DRG),'$P(^(DRG),"^",2) K ^(DRG)
12 D ^PSGPRVR0 K ^TMP("PSG",$J) Q
13 ;
14DRG ;
15 S PRN=$S(PR="999Z":"UNKNOWN",1:$$ENNPN^PSGMI(PR)),DRG=0
16 F S DRG=$O(^PS(57.6,ST,1,W,1,PR,1,DRG)) Q:'DRG I $D(^(DRG,0)) S ND=^(0),DRGN=$S(DRG="999Z":"UNKNOWN",1:$$ENDDN^PSGMI(DRG)),NF=$P($G(^PSDRUG(DRG,0)),U,9) D ADD
17 Q
18 ;
19ADD ;
20 S NU=$G(^TMP("PSG",$J,PRN,DRGN)),^(DRGN)=$P(NU,"^")+$P(ND,"^",2)-$P(ND,"^",4)_"^"_($P(NU,"^",2)+$P(ND,"^",3)-$P(ND,"^",5))_"^"_NF Q
21 ;
22QUES ;
23 K PSGPRVRF S (PSGPRVRF,PSGPRVRP)=""
24SH ;
25 F R !!,"Show ALL or SELECTED providers? ALL// ",PSGPRVRF:DTIME Q:PSGPRVRF="^" D SHC Q:$D(PSGPRVRF)
26 I PSGPRVRF="^" W !!,"...SHOW PROVIDERS not selected, report terminated..." Q
27 I PSGPRVRF="A" G PAGE
28 ;
29SP ;
30 F W !!,"Select ",$S(PSGPRVRF>0:"another ",1:""),"PROVIDER: " R X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D:X?1."?" SPH S DIC="^VA(200,",DIC(0)="QEM",DIC("S")="I $G(^(""PS""))" D ^DIC K DIC I Y>0 S PSGPRVRF=PSGPRVRF+1,PSGPRVRF(+Y)=""
31 I X="^" S PSGPRVRF="^" W !!,"...PROVIDER(S) not selected, report terminated..." Q
32 I 'PSGPRVRF G QUES
33 S PSGPRVRP=1 Q
34 ;
35PAGE ;
36 F W !!,"Do you want to start a new page for each provider" S %='PSGPRVRF+1 D YN^DICN Q:% W !!?2,"Enter 'YES' to have this report start a new page for each provider printed.",!,"Enter '^' to abort this print now."
37 S PSGPRVRP=$S(%<0:"^",1:%=1) Q
38 ;
39SHC ;
40 E W $C(7) S PSGPRVRF="^" Q
41 I PSGPRVRF="" W " (ALL)" S PSGPRVRF="A" Q
42 I PSGPRVRF?1."?" W !!?2,"Enter 'A' (or press RETURN) to show ALL providers on this report. Enter 'S'",!,"to choose which providers you want to show on this report.",!,"PLEASE NOTE: If you choose to select which providers will print, a new "
43 I W "page",!,"will automatically be started for each provider." K PSGPRVRF Q
44 F X="SELECTED","ALL" I $P(X,PSGPRVRF)="" W $P(X,PSGPRVRF,2) S PSGPRVRF=$E(PSGPRVRF) Q
45 E W $C(7)," ??" K PSGPRVRF
46 Q
47 ;
48SPH ;
49 W !!?2,"Select a PROVIDER for which you wish to have cost data print." Q
Note: See TracBrowser for help on using the repository browser.