source: WorldVistAEHR/trunk/r/INTERIM_MANAGEMENT_SUPPORT-ECT/ECTS345.m@ 841

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1ECTS345 ;B'ham ISC/PTD-AMIS 345-346 NHCU/DOM Patient Data ;01/29/91 08:00
2V ;;1.05;INTERIM MANAGEMENT SUPPORT;**7**;
3 ;IF MAS V5> RUNNING, GO TO ENTRY POINT, ELSE USE DIQ
4 G:$D(^DGPM) EN^DGANHD3
5 I '$D(^DGAM(345)) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'AMIS 345&346' File - #42.7 is not loaded on your system.",!! S XQUIT="" Q
6 I '$O(^DGAM(345,0)) W *7,!!,"'AMIS 345-346' File - #42.7 has not been populated on your system.",!! S XQUIT="" Q
7DIC S DIC="^DGAM(345,",DIC(0)="QEAM",DIC("A")="Select REPORT month/year: " D ^DIC K DIC G:Y<0 EXIT S YRDA=+Y
8 I '$O(^DGAM(345,YRDA,"SE",0)) W *7,!!,"No data available for selected month/year." G EXIT
9 K %ZIS S IOP="HOME" D ^%ZIS K %ZIS,IOP S $P(LN,"-",81)=""
10 S SEG=0,QFLG="" F SL=0:0 S SEG=$O(^DGAM(345,YRDA,"SE",SEG)) Q:'SEG Q:QFLG S VS=0 K TMP F VL=0:0 S VS=$O(^DGAM(345,YRDA,"SE",SEG,"D",VS)) Q:'VS Q:QFLG D DIQ
11EXIT K %,%Y,D1,D2,DA,DIC,DIQ,DIR,DR,LN,PC,POP,QFLG,SEG,SL,TMP,VL,VS,X,Y,YRDA
12 Q
13 ;
14DIQ S DIC="^DGAM(345,",DR=".01;10",DR(42.701)=".01;10",DR(42.702)="2:20",DIQ="TMP(",DIQ(0)="E",DA=YRDA,DA(42.701)=SEG,DA(42.702)=VS
15 D EN^DIQ1
16 Q:'$O(TMP(42.7,YRDA,0)) Q:'$O(TMP(42.701,0))
17 ;
18PRTSEG ;DISPLAY 1 SEGMENT
19 W @IOF,!?10,"AMIS "_SEG_" REPORT FOR ",TMP(42.701,SEG,.01,"E")," FOR ",TMP(42.7,YRDA,.01,"E"),!?40,"DIVISION: ",$P(^DG(40.8,VS,0),"^"),!,LN
20 F PC=2:1:20 W !?10,$P(^DD(42.702,PC,0),"^"),?50,$J(+(TMP(42.702,VS,PC,"E")),4)
21 ;
22PRTCHK I $E(IOST)="C" S DIR(0)="E" D ^DIR I Y=0 S QFLG=1 Q
23 Q
24 ;
Note: See TracBrowser for help on using the repository browser.