- AQAQPR2 ;IHS/ANMC/LJF - PROCEDURES BY PROVIDER(PCC DATA); [ 09/28/92 1:08 PM ]
- ;;2.2;STAFF CREDENTIALS;;01 OCT 1992
- ;
- W @IOF,!!?25,"PROCEDURES BY PROVIDER",!!
- W !,"This report gives you a listing (with subcounts) of INPATIENT "
- W !,"procedures by operating provider and OUTPATIENT procedures by"
- W !,"primary provider. You will be asked for a DATE RANGE. You can"
- W !,"get the report for ALL PROVIDERS or only ONE PROVIDER, for ONE"
- W !,"CLASS such as all pediatricians; or one STAFF CATEGORY."
- W !,"The report is SUBTOTALED by provider and within each provider"
- W !,"by procedure category.",!!
- ;
- ;***> select date range
- DATE S %DT="AEQ",%DT("A")="Beginning date: ",X="" D ^%DT
- G END:Y=-1 S AQAQBDT=Y
- DATE2 S %DT="AEQ",%DT("A")="Ending date: ",X="" D ^%DT
- G DATE:Y=-1 S AQAQEDT=Y
- I AQAQEDT<AQAQBDT W *7,!!?5,"Ending date MUST NOT be before beginning date",! G DATE2
- I AQAQEDT'<DT S X1=DT,X2=-1 D C^%DTC S AQAQEDT=X
- ;
- ;***> select one provider, by class or by category
- PRV K DIR S DIR(0)="NO^1:3",DIR("A")="Choose One"
- S DIR("A",1)="1. Print procedures by PROVIDER"
- S DIR("A",2)="2. Print procedures by PROVIDER CLASS"
- S DIR("A",3)="3. Print procedures by STAFF CATEGORY"
- D ^DIR G DATE2:X="",END:$D(DIRUT) S AQAQTYP=+Y
- I AQAQTYP>1 G ONE
- ;
- ALL ;***> choose one or all classes or categories
- K DIR S DIR(0)="Y" S DIR("A")="Print for ALL PROVIDERS"
- S DIR("B")="NO" D ^DIR I Y=1 S AQAQSRT="" G DEV
- I $D(DIRUT) G END ;check for timeout,"^", or null
- ;
- ONE ;***> choose which class or category to print
- K DIR,AQAQSRT
- S DIR(0)="PO^"_$S(AQAQTYP=1:6,AQAQTYP=2:7,1:"")_":EMQZ"
- I AQAQTYP=3 S DIR(0)="9002165,.02"
- D ^DIR G PRV:X="",END:$D(DIRUT)
- S AQAQSRT=Y
- ;
- ;***> select print device
- DEV S %ZIS="PQ" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G ^AQAQPR21
- QUE K IO("Q") S ZTRTN="^AQAQPR21" S ZTDESC="PROCEDURES BY PROVIDER"
- F AQAQI="AQAQBDT","AQAQEDT","AQAQTYP","AQAQSRT" S ZTSAVE(AQAQI)=""
- D ^%ZTLOAD D ^%ZISC K ZTSK
- ;
- END K Y,AQAQBDT,AQAQEDT,AQAQTYP,AQAQSRT,AQAQI,DIR D HOME^%ZIS Q
- ;
- ;
- ERR ;EP;***> entry point to handle errors
- X ^%ZOSF("NBRK")
- ;if OS is DSM or MSM, don't kill variables if not an interrupt
- ;APPROVED EXCEPTION TO STANDARDS - USE OF $ZE
- I $D(^%ZOSF("OS")),(($P(^%ZOSF("OS"),U)["MSM")!($P(^("OS"),U)["DSM")) I $ZE?1"<INRPT>".E D ^%ZISC W *7,!!?30,"Interrupt Acknowledged",!! H 3 I 1
- E D ^%ET
- D END^AQAQPR22 Q
- AQAQPR2 ;IHS/ANMC/LJF - PROCEDURES BY PROVIDER(PCC DATA); [ 09/28/92 1:08 PM ]
- +1 ;;2.2;STAFF CREDENTIALS;;01 OCT 1992
- +2 ;
- +3 WRITE @IOF,!!?25,"PROCEDURES BY PROVIDER",!!
- +4 WRITE !,"This report gives you a listing (with subcounts) of INPATIENT "
- +5 WRITE !,"procedures by operating provider and OUTPATIENT procedures by"
- +6 WRITE !,"primary provider. You will be asked for a DATE RANGE. You can"
- +7 WRITE !,"get the report for ALL PROVIDERS or only ONE PROVIDER, for ONE"
- +8 WRITE !,"CLASS such as all pediatricians; or one STAFF CATEGORY."
- +9 WRITE !,"The report is SUBTOTALED by provider and within each provider"
- +10 WRITE !,"by procedure category.",!!
- +11 ;
- +12 ;***> select date range
- DATE SET %DT="AEQ"
- SET %DT("A")="Beginning date: "
- SET X=""
- DO ^%DT
- +1 IF Y=-1
- GOTO END
- SET AQAQBDT=Y
- DATE2 SET %DT="AEQ"
- SET %DT("A")="Ending date: "
- SET X=""
- DO ^%DT
- +1 IF Y=-1
- GOTO DATE
- SET AQAQEDT=Y
- +2 IF AQAQEDT<AQAQBDT
- WRITE *7,!!?5,"Ending date MUST NOT be before beginning date",!
- GOTO DATE2
- +3 IF AQAQEDT'<DT
- SET X1=DT
- SET X2=-1
- DO C^%DTC
- SET AQAQEDT=X
- +4 ;
- +5 ;***> select one provider, by class or by category
- PRV KILL DIR
- SET DIR(0)="NO^1:3"
- SET DIR("A")="Choose One"
- +1 SET DIR("A",1)="1. Print procedures by PROVIDER"
- +2 SET DIR("A",2)="2. Print procedures by PROVIDER CLASS"
- +3 SET DIR("A",3)="3. Print procedures by STAFF CATEGORY"
- +4 DO ^DIR
- IF X=""
- GOTO DATE2
- IF $DATA(DIRUT)
- GOTO END
- SET AQAQTYP=+Y
- +5 IF AQAQTYP>1
- GOTO ONE
- +6 ;
- ALL ;***> choose one or all classes or categories
- +1 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Print for ALL PROVIDERS"
- +2 SET DIR("B")="NO"
- DO ^DIR
- IF Y=1
- SET AQAQSRT=""
- GOTO DEV
- +3 ;check for timeout,"^", or null
- IF $DATA(DIRUT)
- GOTO END
- +4 ;
- ONE ;***> choose which class or category to print
- +1 KILL DIR,AQAQSRT
- +2 SET DIR(0)="PO^"_$SELECT(AQAQTYP=1:6,AQAQTYP=2:7,1:"")_":EMQZ"
- +3 IF AQAQTYP=3
- SET DIR(0)="9002165,.02"
- +4 DO ^DIR
- IF X=""
- GOTO PRV
- IF $DATA(DIRUT)
- GOTO END
- +5 SET AQAQSRT=Y
- +6 ;
- +7 ;***> select print device
- DEV SET %ZIS="PQ"
- DO ^%ZIS
- IF POP
- GOTO END
- IF $DATA(IO("Q"))
- GOTO QUE
- USE IO
- GOTO ^AQAQPR21
- QUE KILL IO("Q")
- SET ZTRTN="^AQAQPR21"
- SET ZTDESC="PROCEDURES BY PROVIDER"
- +1 FOR AQAQI="AQAQBDT","AQAQEDT","AQAQTYP","AQAQSRT"
- SET ZTSAVE(AQAQI)=""
- +2 DO ^%ZTLOAD
- DO ^%ZISC
- KILL ZTSK
- +3 ;
- END KILL Y,AQAQBDT,AQAQEDT,AQAQTYP,AQAQSRT,AQAQI,DIR
- DO HOME^%ZIS
- QUIT
- +1 ;
- +2 ;
- ERR ;EP;***> entry point to handle errors
- +1 XECUTE ^%ZOSF("NBRK")
- +2 ;if OS is DSM or MSM, don't kill variables if not an interrupt
- +3 ;APPROVED EXCEPTION TO STANDARDS - USE OF $ZE
- +4 IF $DATA(^%ZOSF("OS"))
- IF (($PIECE(^%ZOSF("OS"),U)["MSM")!($PIECE(^("OS"),U)["DSM"))
- IF $ZE?1"<INRPT>".E
- DO ^%ZISC
- WRITE *7,!!?30,"Interrupt Acknowledged",!!
- HANG 3
- IF 1
- +5 IF '$TEST
- DO ^%ET
- +6 DO END^AQAQPR22
- QUIT
