- AQAOPC80 ; IHS/ORDC/LJF - OCC BY PROVIDER ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This trending report by provider is similar to the one by special
- ;review type. It adds the provider as an additional sort on top of
- ;one of the 3 main trending reports.
- ;Added for Enhancement #1; called by AQAOPC8
- ;
- S AQAOXSM="PROV" ;line label used by ^aqaopcx
- S AQAOXSN=$O(^AQAO1(9,"B","PROVIDER",0)) I AQAOXSN="" D EXIT Q
- ;
- PROV ; -- ask for provider or person or vendor
- W !! K DIR S DIR(0)="N^1:5",DIR("B")=1
- S DIR("A",1)=" Who do you want included in the Trending Report?"
- S DIR("A",2)=" "
- S DIR("A",3)=" 1. One IHS PROVIDER"
- S DIR("A",4)=" 2. One IHS EMPLOYEE"
- S DIR("A",5)=" 3. One CHS PROVIDER"
- S DIR("A",6)=" 4. All IHS PROVIDERS within a Class"
- S DIR("A",7)=" 5. All CHS PROVIDERS within a Type"
- S DIR("A",8)=" 6. ALL Providers/Employees"
- S DIR("A",9)=" "
- S DIR("A")=" Select ONE by number"
- S DIR("?",1)="Choose #1 to print a report for one IHS provider;"
- S DIR("?",2)="Choose #2 to print a report for one non-provider employee."
- S DIR("?",3)="Choose #3 for a specific CHS provider."
- S DIR("?",4)="Choose #4 to print the report for all IHS providers"
- S DIR("?",5)=" within a specific provider class (i.e., Surgeon)"
- S DIR("?",6)="Choose #5 to print the report for all CHS providers"
- S DIR("?",7)=" within a specific CHS provider type."
- S DIR("?",8)="Choose #6 to include all providers/persons in the report."
- S DIR("?",7)=" ",DIR("?")="Make your selection by number."
- D ^DIR I $D(DTOUT)!$D(DUOUT) D EXIT Q
- ;
- K AQAOXS S AQAOSRT=+Y
- I Y=6 S AQAOXS(0)="" D RPT Q ;multiple categories sorted by name
- ;
- S X=$S(AQAOSRT=1:"I $D(^XUSEC(""PROVIDER"",+Y))",1:"")
- I AQAOSRT=1 D ASK(200,"IHS PROVIDER",X)
- I AQAOSRT=2 D ASK(200,"IHS EMPLOYEE",X)
- I AQAOSRT=3 D ASK(9999999.11,"CHS PROVIDER",X)
- I AQAOSRT=4 D ASK(7,"IHS PROVIDER CLASS",X)
- I AQAOSRT=5 D ASK(9999999.34,"CHS PROVIDER TYPE",X)
- I '$D(AQAOXS) D PROV Q
- ;
- RPT ; -- ask user to select report to run
- W !!," AVAILABLE OCCURRENCE REPORTS:",! K DIR S DIR(0)="NO^1:4"
- S DIR("A")=" Select REPORT to print"
- F I=1:1:4 S DIR("A",I)=" "_I_". "_$P($T(RTN+I),";;",2)
- S DIR("A",5)=" " D ^DIR G EXIT:$D(DTOUT),PROV:$D(DIRUT),RPT:Y=-1
- S AQAORTN=$P($T(RTN+Y),";;",3) D @AQAORTN
- ;
- EXIT ; -- eoj
- D KILL^AQAOUTIL Q
- ;
- ;
- ASK(DIC,DICA,DICS) ; -- SUBRTN to ask user to choose one item
- S:DICA["" DIC("A")="Select "_DICA_": " S:DICS]"" DIC("S")=DICS
- S DIC(0)="AEMQZ" W !! D ^DIC Q:$D(DTOUT) Q:$D(DUOUT) Q:Y=-1
- I AQAOSRT<4 S AQAOXS(1,+Y)=+Y Q
- ;
- S AQAOK=$O(^DIC(19.1,"B","PROVIDER",0)) I AQAOSRT=4,AQAOK]"" D Q
- .W !,"Searching for all ACTIVE IHS Providers within this CLASS. . ."
- .S X=0 F S X=$O(^VA(200,"AB",AQAOK,X)) Q:X="" D
- ..I $P($G(^VA(200,X,"PS")),U,4)]"",$P(^("PS"),U,4)'>DT Q ;inactive
- ..Q:$P($G(^VA(200,X,"PS")),U,5)'=+Y ;wrong prov class
- ..S AQAOXS(1,X)=X
- ;
- W !,"Searching for all ACTIVE CHS Providers within this TYPE. . ."
- S X=0 F S X=$O(^AUTTVNDR(X)) Q:X'=+X D
- .Q:$$VAL^XBDIQ1(9999999.11,X,.05)]"" ;inactive provider
- .Q:$$VALI^XBDIQ1(9999999.11,X,1103)'=+Y ;wrong prov type
- .S AQAOXS(1,X)=X
- Q
- ;
- ;
- PROFILE1 ;EP; -- SUBRTN to ask for provider or person or vendor
- ; called by AQAOPC8
- W !! K DIR S DIR(0)="N^1:3",DIR("B")=1
- S DIR("A")="Select ONE by Number"
- S DIR("A",1)=" 1. IHS PROVIDER Profile"
- S DIR("A",2)=" 2. IHS PERSON Profile"
- S DIR("A",3)=" 3. CHS PROVIDER Profile",DIR("A",4)=" "
- S DIR("?",1)="Choose #1 for a profile on a direct care provider"
- S DIR("?",2)="Choose #2 for an IHS employee or volunteer"
- S DIR("?",3)="Choose #3 for a contract health care provider"
- S DIR("?")="Choose the type of profile you want to print"
- D ^DIR Q:$D(DTOUT) Q:$D(DUOUT)
- S X=$S(Y=1:"I $D(^XUSEC(""PROVIDER"",+Y))",1:"")
- I Y=1 D ASKP(200,"IHS PROVIDER",X,.AQAOPROV,.AQAOPRVN)
- I Y=2 D ASKP(200,"IHS PERSON",X,.AQAOPROV,.AQAOPRVN)
- I Y=3 D ASKP(9999999.11,"CHS PROVIDER",X,.AQAOPROV,.AQAOPRVN)
- I '$D(AQAOPROV) D PROFILE1
- Q
- ;
- ;
- ASKP(DIC,DICA,DICS,AQAOPROV,AQAOPRVN) ; -- SUBRTN to ask prov,pers,vendr name
- N X S:DICA]"" DIC("A")="Select "_DICA_": " S:DICS]"" DIC("S")=DICS
- W !! S DIC(0)="AEMQZ" D ^DIC Q:$D(DTOUT) Q:$D(DUOUT) Q:Y=-1
- S AQAOPROV=+Y_";"_$P(DIC,U,2)
- S AQAOPRVN=Y(0,0)
- Q
- ;
- ;
- RTN ;;
- ;;Occurrences By REVIEW CRITERIA;;^AQAOPC1
- ;;Occurrences By DIAGNOSIS/PROCEDURE;;^AQAOPC2
- ;;Occurrences By FINDINGS/ACTIONS;;^AQAOPC4
- ;;Occurrences for SINGLE CRIERION by MONTH;;^AQAOPC7
- AQAOPC80 ; IHS/ORDC/LJF - OCC BY PROVIDER ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This trending report by provider is similar to the one by special
- +4 ;review type. It adds the provider as an additional sort on top of
- +5 ;one of the 3 main trending reports.
- +6 ;Added for Enhancement #1; called by AQAOPC8
- +7 ;
- +8 ;line label used by ^aqaopcx
- SET AQAOXSM="PROV"
- +9 SET AQAOXSN=$ORDER(^AQAO1(9,"B","PROVIDER",0))
- IF AQAOXSN=""
- DO EXIT
- QUIT
- +10 ;
- PROV ; -- ask for provider or person or vendor
- +1 WRITE !!
- KILL DIR
- SET DIR(0)="N^1:5"
- SET DIR("B")=1
- +2 SET DIR("A",1)=" Who do you want included in the Trending Report?"
- +3 SET DIR("A",2)=" "
- +4 SET DIR("A",3)=" 1. One IHS PROVIDER"
- +5 SET DIR("A",4)=" 2. One IHS EMPLOYEE"
- +6 SET DIR("A",5)=" 3. One CHS PROVIDER"
- +7 SET DIR("A",6)=" 4. All IHS PROVIDERS within a Class"
- +8 SET DIR("A",7)=" 5. All CHS PROVIDERS within a Type"
- +9 SET DIR("A",8)=" 6. ALL Providers/Employees"
- +10 SET DIR("A",9)=" "
- +11 SET DIR("A")=" Select ONE by number"
- +12 SET DIR("?",1)="Choose #1 to print a report for one IHS provider;"
- +13 SET DIR("?",2)="Choose #2 to print a report for one non-provider employee."
- +14 SET DIR("?",3)="Choose #3 for a specific CHS provider."
- +15 SET DIR("?",4)="Choose #4 to print the report for all IHS providers"
- +16 SET DIR("?",5)=" within a specific provider class (i.e., Surgeon)"
- +17 SET DIR("?",6)="Choose #5 to print the report for all CHS providers"
- +18 SET DIR("?",7)=" within a specific CHS provider type."
- +19 SET DIR("?",8)="Choose #6 to include all providers/persons in the report."
- +20 SET DIR("?",7)=" "
- SET DIR("?")="Make your selection by number."
- +21 DO ^DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- DO EXIT
- QUIT
- +22 ;
- +23 KILL AQAOXS
- SET AQAOSRT=+Y
- +24 ;multiple categories sorted by name
- IF Y=6
- SET AQAOXS(0)=""
- DO RPT
- QUIT
- +25 ;
- +26 SET X=$SELECT(AQAOSRT=1:"I $D(^XUSEC(""PROVIDER"",+Y))",1:"")
- +27 IF AQAOSRT=1
- DO ASK(200,"IHS PROVIDER",X)
- +28 IF AQAOSRT=2
- DO ASK(200,"IHS EMPLOYEE",X)
- +29 IF AQAOSRT=3
- DO ASK(9999999.11,"CHS PROVIDER",X)
- +30 IF AQAOSRT=4
- DO ASK(7,"IHS PROVIDER CLASS",X)
- +31 IF AQAOSRT=5
- DO ASK(9999999.34,"CHS PROVIDER TYPE",X)
- +32 IF '$DATA(AQAOXS)
- DO PROV
- QUIT
- +33 ;
- RPT ; -- ask user to select report to run
- +1 WRITE !!," AVAILABLE OCCURRENCE REPORTS:",!
- KILL DIR
- SET DIR(0)="NO^1:4"
- +2 SET DIR("A")=" Select REPORT to print"
- +3 FOR I=1:1:4
- SET DIR("A",I)=" "_I_". "_$PIECE($TEXT(RTN+I),";;",2)
- +4 SET DIR("A",5)=" "
- DO ^DIR
- IF $DATA(DTOUT)
- GOTO EXIT
- IF $DATA(DIRUT)
- GOTO PROV
- IF Y=-1
- GOTO RPT
- +5 SET AQAORTN=$PIECE($TEXT(RTN+Y),";;",3)
- DO @AQAORTN
- +6 ;
- EXIT ; -- eoj
- +1 DO KILL^AQAOUTIL
- QUIT
- +2 ;
- +3 ;
- ASK(DIC,DICA,DICS) ; -- SUBRTN to ask user to choose one item
- +1 IF DICA[""
- SET DIC("A")="Select "_DICA_": "
- IF DICS]""
- SET DIC("S")=DICS
- +2 SET DIC(0)="AEMQZ"
- WRITE !!
- DO ^DIC
- IF $DATA(DTOUT)
- QUIT
- IF $DATA(DUOUT)
- QUIT
- IF Y=-1
- QUIT
- +3 IF AQAOSRT<4
- SET AQAOXS(1,+Y)=+Y
- QUIT
- +4 ;
- +5 SET AQAOK=$ORDER(^DIC(19.1,"B","PROVIDER",0))
- IF AQAOSRT=4
- IF AQAOK]""
- Begin DoDot:1
- +6 WRITE !,"Searching for all ACTIVE IHS Providers within this CLASS. . ."
- +7 SET X=0
- FOR
- SET X=$ORDER(^VA(200,"AB",AQAOK,X))
- IF X=""
- QUIT
- Begin DoDot:2
- +8 ;inactive
- IF $PIECE($GET(^VA(200,X,"PS")),U,4)]""
- IF $PIECE(^("PS"),U,4)'>DT
- QUIT
- +9 ;wrong prov class
- IF $PIECE($GET(^VA(200,X,"PS")),U,5)'=+Y
- QUIT
- +10 SET AQAOXS(1,X)=X
- End DoDot:2
- End DoDot:1
- QUIT
- +11 ;
- +12 WRITE !,"Searching for all ACTIVE CHS Providers within this TYPE. . ."
- +13 SET X=0
- FOR
- SET X=$ORDER(^AUTTVNDR(X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +14 ;inactive provider
- IF $$VAL^XBDIQ1(9999999.11,X,.05)]""
- QUIT
- +15 ;wrong prov type
- IF $$VALI^XBDIQ1(9999999.11,X,1103)'=+Y
- QUIT
- +16 SET AQAOXS(1,X)=X
- End DoDot:1
- +17 QUIT
- +18 ;
- +19 ;
- PROFILE1 ;EP; -- SUBRTN to ask for provider or person or vendor
- +1 ; called by AQAOPC8
- +2 WRITE !!
- KILL DIR
- SET DIR(0)="N^1:3"
- SET DIR("B")=1
- +3 SET DIR("A")="Select ONE by Number"
- +4 SET DIR("A",1)=" 1. IHS PROVIDER Profile"
- +5 SET DIR("A",2)=" 2. IHS PERSON Profile"
- +6 SET DIR("A",3)=" 3. CHS PROVIDER Profile"
- SET DIR("A",4)=" "
- +7 SET DIR("?",1)="Choose #1 for a profile on a direct care provider"
- +8 SET DIR("?",2)="Choose #2 for an IHS employee or volunteer"
- +9 SET DIR("?",3)="Choose #3 for a contract health care provider"
- +10 SET DIR("?")="Choose the type of profile you want to print"
- +11 DO ^DIR
- IF $DATA(DTOUT)
- QUIT
- IF $DATA(DUOUT)
- QUIT
- +12 SET X=$SELECT(Y=1:"I $D(^XUSEC(""PROVIDER"",+Y))",1:"")
- +13 IF Y=1
- DO ASKP(200,"IHS PROVIDER",X,.AQAOPROV,.AQAOPRVN)
- +14 IF Y=2
- DO ASKP(200,"IHS PERSON",X,.AQAOPROV,.AQAOPRVN)
- +15 IF Y=3
- DO ASKP(9999999.11,"CHS PROVIDER",X,.AQAOPROV,.AQAOPRVN)
- +16 IF '$DATA(AQAOPROV)
- DO PROFILE1
- +17 QUIT
- +18 ;
- +19 ;
- ASKP(DIC,DICA,DICS,AQAOPROV,AQAOPRVN) ; -- SUBRTN to ask prov,pers,vendr name
- +1 NEW X
- IF DICA]""
- SET DIC("A")="Select "_DICA_": "
- IF DICS]""
- SET DIC("S")=DICS
- +2 WRITE !!
- SET DIC(0)="AEMQZ"
- DO ^DIC
- IF $DATA(DTOUT)
- QUIT
- IF $DATA(DUOUT)
- QUIT
- IF Y=-1
- QUIT
- +3 SET AQAOPROV=+Y_";"_$PIECE(DIC,U,2)
- +4 SET AQAOPRVN=Y(0,0)
- +5 QUIT
- +6 ;
- +7 ;
- RTN ;;
- +1 ;;Occurrences By REVIEW CRITERIA;;^AQAOPC1
- +2 ;;Occurrences By DIAGNOSIS/PROCEDURE;;^AQAOPC2
- +3 ;;Occurrences By FINDINGS/ACTIONS;;^AQAOPC4
- +4 ;;Occurrences for SINGLE CRIERION by MONTH;;^AQAOPC7