- ADGCEN2 ; IHS/ADC/PDW/ENM - CENSUS AID-LIST BY SERVICE ONLY ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- ;This rtn lists census data for a selected treating specialty
- ;to aid the admitting supervisor in finding errors
- ;
- W @IOF W !!?30,"LIST CENSUS DATA BY SERVICE",!!
- ;
- SRV K DIR S DIR(0)="PO^9009011.5:EQMZ" D ^DIR
- G END:$D(DIRUT),SRV:Y=-1 S DGSRV=+Y
- ;
- AGE K DIR S DIR("A")="Adult or Pediatric Census"
- S DIR(0)="SO^A:ADULT;P:PEDIATRIC"
- S DIR("?",1)="This report displays either adult census figures"
- S DIR("?",2)="or pediatric ones.",DIR("?")="Please choose one; A or P."
- D ^DIR G SRV:$D(DIRUT),AGE:Y=-1
- S DGAGE=$S(Y="A":0,1:1) ;0node=adult; 1node=peds
- ;
- BDATE S %DT="AEQ",%DT("A")="Select beginning date: ",X="" D ^%DT
- G END:Y=-1 S DGBDT=Y
- EDATE S %DT="AEQ",%DT("A")="Select ending date: ",X="" D ^%DT
- G END:Y=-1 S DGEDT=Y
- ;
- S %ZIS="Q" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G ^ADGCEN20
- QUE K IO("Q") S ZTRTN="^ADGCEN20",ZTDESC="CENSUS AID 2"
- F DGI="DGBDT","DGEDT","DGSRV","DGAGE" S ZTSAVE(DGI)=""
- D ^%ZTLOAD D ^%ZISC K ZTSK
- END K Y,DGBDT,DGEDT,DGSRV,DGAGE,DIR,DGI D HOME^%ZIS Q
- ADGCEN2 ; IHS/ADC/PDW/ENM - CENSUS AID-LIST BY SERVICE ONLY ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 ;This rtn lists census data for a selected treating specialty
- +4 ;to aid the admitting supervisor in finding errors
- +5 ;
- +6 WRITE @IOF
- WRITE !!?30,"LIST CENSUS DATA BY SERVICE",!!
- +7 ;
- SRV KILL DIR
- SET DIR(0)="PO^9009011.5:EQMZ"
- DO ^DIR
- +1 IF $DATA(DIRUT)
- GOTO END
- IF Y=-1
- GOTO SRV
- SET DGSRV=+Y
- +2 ;
- AGE KILL DIR
- SET DIR("A")="Adult or Pediatric Census"
- +1 SET DIR(0)="SO^A:ADULT;P:PEDIATRIC"
- +2 SET DIR("?",1)="This report displays either adult census figures"
- +3 SET DIR("?",2)="or pediatric ones."
- SET DIR("?")="Please choose one; A or P."
- +4 DO ^DIR
- IF $DATA(DIRUT)
- GOTO SRV
- IF Y=-1
- GOTO AGE
- +5 ;0node=adult; 1node=peds
- SET DGAGE=$SELECT(Y="A":0,1:1)
- +6 ;
- BDATE SET %DT="AEQ"
- SET %DT("A")="Select beginning date: "
- SET X=""
- DO ^%DT
- +1 IF Y=-1
- GOTO END
- SET DGBDT=Y
- EDATE SET %DT="AEQ"
- SET %DT("A")="Select ending date: "
- SET X=""
- DO ^%DT
- +1 IF Y=-1
- GOTO END
- SET DGEDT=Y
- +2 ;
- +3 SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- GOTO END
- IF $DATA(IO("Q"))
- GOTO QUE
- USE IO
- GOTO ^ADGCEN20
- QUE KILL IO("Q")
- SET ZTRTN="^ADGCEN20"
- SET ZTDESC="CENSUS AID 2"
- +1 FOR DGI="DGBDT","DGEDT","DGSRV","DGAGE"
- SET ZTSAVE(DGI)=""
- +2 DO ^%ZTLOAD
- DO ^%ZISC
- KILL ZTSK
- END KILL Y,DGBDT,DGEDT,DGSRV,DGAGE,DIR,DGI
- DO HOME^%ZIS
- QUIT
