- ECTS345 ;B'ham ISC/PTD-AMIS 345-346 NHCU/DOM Patient Data ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**7**;
- ;IF MAS V5> RUNNING, GO TO ENTRY POINT, ELSE USE DIQ
- G:$D(^DGPM) EN^DGANHD3
- 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
- I '$O(^DGAM(345,0)) W *7,!!,"'AMIS 345-346' File - #42.7 has not been populated on your system.",!! S XQUIT="" Q
- DIC S DIC="^DGAM(345,",DIC(0)="QEAM",DIC("A")="Select REPORT month/year: " D ^DIC K DIC G:Y<0 EXIT S YRDA=+Y
- I '$O(^DGAM(345,YRDA,"SE",0)) W *7,!!,"No data available for selected month/year." G EXIT
- K %ZIS S IOP="HOME" D ^%ZIS K %ZIS,IOP S $P(LN,"-",81)=""
- 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
- EXIT K %,%Y,D1,D2,DA,DIC,DIQ,DIR,DR,LN,PC,POP,QFLG,SEG,SL,TMP,VL,VS,X,Y,YRDA
- Q
- ;
- DIQ 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
- D EN^DIQ1
- Q:'$O(TMP(42.7,YRDA,0)) Q:'$O(TMP(42.701,0))
- ;
- PRTSEG ;DISPLAY 1 SEGMENT
- 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
- F PC=2:1:20 W !?10,$P(^DD(42.702,PC,0),"^"),?50,$J(+(TMP(42.702,VS,PC,"E")),4)
- ;
- PRTCHK I $E(IOST)="C" S DIR(0)="E" D ^DIR I Y=0 S QFLG=1 Q
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTS345 1481 printed Feb 18, 2025@23:29:12 Page 2
- ECTS345 ;B'ham ISC/PTD-AMIS 345-346 NHCU/DOM Patient Data ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**7**;
- +1 ;IF MAS V5> RUNNING, GO TO ENTRY POINT, ELSE USE DIQ
- +2 if $DATA(^DGPM)
- GOTO EN^DGANHD3
- +3 IF '$DATA(^DGAM(345))
- WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'AMIS 345&346' File - #42.7 is not loaded on your system.",!!
- SET XQUIT=""
- QUIT
- +4 IF '$ORDER(^DGAM(345,0))
- WRITE *7,!!,"'AMIS 345-346' File - #42.7 has not been populated on your system.",!!
- SET XQUIT=""
- QUIT
- DIC SET DIC="^DGAM(345,"
- SET DIC(0)="QEAM"
- SET DIC("A")="Select REPORT month/year: "
- DO ^DIC
- KILL DIC
- if Y<0
- GOTO EXIT
- SET YRDA=+Y
- +1 IF '$ORDER(^DGAM(345,YRDA,"SE",0))
- WRITE *7,!!,"No data available for selected month/year."
- GOTO EXIT
- +2 KILL %ZIS
- SET IOP="HOME"
- DO ^%ZIS
- KILL %ZIS,IOP
- SET $PIECE(LN,"-",81)=""
- +3 SET SEG=0
- SET QFLG=""
- FOR SL=0:0
- SET SEG=$ORDER(^DGAM(345,YRDA,"SE",SEG))
- if 'SEG
- QUIT
- if QFLG
- QUIT
- SET VS=0
- KILL TMP
- FOR VL=0:0
- SET VS=$ORDER(^DGAM(345,YRDA,"SE",SEG,"D",VS))
- if 'VS
- QUIT
- if QFLG
- QUIT
- DO DIQ
- EXIT KILL %,%Y,D1,D2,DA,DIC,DIQ,DIR,DR,LN,PC,POP,QFLG,SEG,SL,TMP,VL,VS,X,Y,YRDA
- +1 QUIT
- +2 ;
- DIQ SET DIC="^DGAM(345,"
- SET DR=".01;10"
- SET DR(42.701)=".01;10"
- SET DR(42.702)="2:20"
- SET DIQ="TMP("
- SET DIQ(0)="E"
- SET DA=YRDA
- SET DA(42.701)=SEG
- SET DA(42.702)=VS
- +1 DO EN^DIQ1
- +2 if '$ORDER(TMP(42.7,YRDA,0))
- QUIT
- if '$ORDER(TMP(42.701,0))
- QUIT
- +3 ;
- PRTSEG ;DISPLAY 1 SEGMENT
- +1 WRITE @IOF,!?10,"AMIS "_SEG_" REPORT FOR ",TMP(42.701,SEG,.01,"E")," FOR ",TMP(42.7,YRDA,.01,"E"),!?40,"DIVISION: ",$PIECE(^DG(40.8,VS,0),"^"),!,LN
- +2 FOR PC=2:1:20
- WRITE !?10,$PIECE(^DD(42.702,PC,0),"^"),?50,$JUSTIFY(+(TMP(42.702,VS,PC,"E")),4)
- +3 ;
- PRTCHK IF $EXTRACT(IOST)="C"
- SET DIR(0)="E"
- DO ^DIR
- IF Y=0
- SET QFLG=1
- QUIT
- +1 QUIT
- +2 ;
