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
