- AGAGERP ; VNGT/IHS/DLS - Patient Age Specific Report ; April 29, 2010
- ;;7.1;PATIENT REGISTRATION;**8,9**;AUG 25, 2005
- ;
- VAR N TAG,EXCL,EXCLS,AGLINE,AGINS
- K ^TMP("AGAGERP",$J)
- ;
- ;Initialize Variables
- ;
- D INTRO
- PLOOP ; For looping back to paremeter menu.
- D GETPARAM
- I '$D(EXCL) G EXIT
- I ($G(EXCL("Elig Date Range"))'="")&($G(EXCL("Alternate Resource"))="") D G PLOOP
- . W !!," ============================================================================"
- . W !," An Alternate Resource of 'MEDICARE', 'MEDICAID', 'PRIVATE INSURANCE',"
- . W !," 'SPECIFIC INSURER', 'WORKMEN'S COMP', 'PRIVATE & WORKMEN'S COMP', or 'CHIP'"
- . W !," must be selected when entering a Point in Time date. Patients with eligibil-"
- . W !," ity up to 3 years before the date entered will be included in the selection"
- . W !," process."
- . W !," ============================================================================",!
- . K DIR D RTRN^AG
- DEV ;
- S %ZIS="QA"
- D ^%ZIS
- I POP N IOP S IOP=ION D ^%ZIS Q
- I $G(IO("Q")) D QUE D HOME^%ZIS Q
- U IO
- D GO
- D ^%ZISC
- D HOME^%ZIS
- Q
- GO ; Proceed with processing
- D GETDATA^AGAGERP1
- D PRINT^AGAGERP2
- G EXIT
- Q
- ;
- INTRO ; Introduction Screen
- W !!!," NOTE: To run this report you must select at least one parameter."
- W !," If no parameters are selected, you will return to the reports menu.",!
- D RTRN^AG
- Q
- ;
- GETPARAM ; Main Report Driver
- W @IOF
- I $D(EXCL) D EXCLIST
- N TAG,X,Y
- K DIR
- S DIR("A")=" Select ONE or MORE of the above EXCLUSION PARAMETERS"
- S DIR(0)="SO^1:LOCATION;2:ALTERNATE RESOURCE;3:DATE;4:AGE RANGE;5:ELIGIBILITY STATUS"
- S DIR("L",1)=" Select one of the following:"
- S DIR("L",2)=""
- S DIR("L",3)=" 1 LOCATION"
- S DIR("L",4)=" 2 ALTERNATE RESOURCE"
- S DIR("L",5)=" 3 DATE RANGE"
- S DIR("L",6)=" 4 AGE RANGE"
- S DIR("L")=" 5 ELIGIBILITY STATUS"
- D ^DIR K DIR
- Q:Y=""
- I Y["^" K EXCL Q
- S TAG="ASK"_$E(Y(0),1,3)
- D @TAG
- K TAG
- D GETPARAM
- Q
- ;
- EXCLIST ; List Exclusion Paramenters selected so far.
- W !!!
- W " EXCLUSION PARAMETERS Currently in Effect for RESTRICTING the EXPORT to:"
- W !," ======================================================================="
- N EXCLS,AGDOTS,AGDOTLN
- S EXCLS="" F S EXCLS=$O(EXCL(EXCLS)) Q:EXCLS="" D
- . W !," - ",EXCLS
- . S AGDOTS=22-$L(EXCLS)
- . S AGDOTLN=""
- . S $P(AGDOTLN,".",AGDOTS)=""
- . W AGDOTLN,": ",$P($G(EXCL(EXCLS)),U,2)
- . I EXCLS="Visit Date Range" W " - ",$P($G(EXCL(EXCLS)),U,4)
- . I EXCLS="Elig Date Range" W " - ",$P($G(EXCL(EXCLS)),U,4)
- Q
- ;
- ASKLOC ; Prompts to get location
- K DIR
- S DIR(0)="PO^9999999.06,DUZ(2),:AEM"
- S DIR("A")=" Enter a location"
- S:$D(EXCL("Location")) DIR("B")=$P(EXCL("Location"),U,2)
- D ^DIR K DIR
- I X["@" K EXCL("Location") Q
- Q:(X="")!(X["^")
- S EXCL("Location")=+Y_U_$$GET1^DIQ(4,+Y,.01)
- Q
- ;
- ASKALT ; Prompts to get Alt Resource
- N X,Y
- K DIR
- S DIR("A")=" Select TYPE of ALTERNATE RESOURCE to Display"
- S:$D(EXCL("Alternate Resource")) DIR("B")=$P(EXCL("Alternate Resource"),"^",2)
- S DIR(0)="SO^1:MEDICARE;2:MEDICAID;3:PRIVATE INSURANCE;4:SPECIFIC INSURER;5:SPECIFIC PATIENT;6:WORKMEN'S COMP;7:PRIVATE + WORKMEN'S COMP;8:CHIP;9:NO RESOURCES"
- S DIR("L",1)=" Select one of the following:"
- S DIR("L",2)=""
- S DIR("L",3)=" 1 MEDICARE"
- S DIR("L",4)=" 2 MEDICAID"
- S DIR("L",5)=" 3 PRIVATE INSURANCE"
- S DIR("L",6)=" 4 SPECIFIC INSURER"
- S DIR("L",7)=" 5 SPECIFIC PATIENT"
- S DIR("L",8)=" 6 WORKMEN'S COMP"
- S DIR("L",9)=" 7 PRIVATE + WORKMEN'S COMP"
- S DIR("L")=" 8 CHIP"
- D ^DIR K DIR
- I X=4 S EXCL("Alternate Resource")="4^SPECIFIC INSURER" D ASKINS Q
- I X=5 D ASKPNT Q
- I X["@" K EXCL("Alternate Resource") Q
- Q:(X="")!(X["^")
- S EXCL("Alternate Resource")=Y_U_Y(0)
- Q
- ;
- ASKDAT ; Prompts to get date type
- N TAG
- K DIR
- S DIR("A")=" Select type of Date Desired"
- S DIR(0)="SO^1:Visit Date;2:Point in Time"
- S DIR("L",1)=" 1 Visit Date"
- S DIR("L")=" 2 Point in Time"
- D ^DIR K DIR
- Q:(X="")!(X["^")!(X["@")
- S TAG="ASK"_$E(Y(0),1,3)
- I Y=1 S TAG="ASKVIS"
- I Y=2 S TAG="ASKPOI"
- D @TAG
- K TAG
- Q
- ;
- ASKVIS ; Prompts to get Visits within date range
- K DIR
- K EXCL("Elig Date Range")
- N Y1,Y2,Y3,Y4
- W !!," ============ Entry of VISIT DATE Range ===========",!
- S DIR("A")=" Enter STARTING VISIT DATE for the Report"
- S:$D(EXCL("Visit Date Range")) DIR("B")=$P(EXCL("Visit Date Range"),"^",2)
- S DIR(0)="DO"
- D ^DIR K DIR
- I X["@" K EXCL("Visit Date Range") Q
- Q:(X="")!(X["^")!(X["@")
- W "// ",Y(0)
- S Y1=Y
- I $G(Y1)]"" S Y=Y1 D DD^%DT S Y2=Y
- S DIR("A")=" Enter ENDING DATE for the Report"
- S:$D(EXCL("Visit Date Range")) DIR("B")=$P(EXCL("Visit Date Range"),"^",4)
- S DIR(0)="DO"
- D ^DIR K DIR
- I X["@" K EXCL("Visit Date Range") Q
- Q:(X="")!(X["^")!(X["@")
- W "// ",Y(0)
- S Y3=Y D DD^%DT S Y4=4
- I Y3<Y1 D Q
- . W !!," To Date must be after From Date. Please try again."
- . K EXCL("Visit Date Range")
- . D ASKVIS
- I $G(Y3)]"" S Y=Y3 D DD^%DT S Y4=Y
- S EXCL("Visit Date Range")=$G(Y1)_U_$G(Y2)_U_$G(Y3)_U_$G(Y4)
- Q
- ;
- ASKPOI ; Prompt for Elig date
- K DIR
- K EXCL("Visit Date Range")
- N Y1,Y2,Y3,Y4
- W !!," =========== Point in Time Date for Alternate Resource Eligibility:============"
- W !," An Alternate Resource of 'MEDICARE', 'MEDICAID', 'PRIVATE INSURANCE',"
- W !," 'SPECIFIC INSURER', 'WORKMEN'S COMP', 'PRIVATE & WORKMEN'S COMP', or 'CHIP'"
- W !," must be selected when entering a Point in Time date. Patients with eligibil-"
- W !," ity up to 3 years before the date entered will be included in the selection"
- W !," process."
- W !," ===============================================================================",!
- S DIR("A")=" Enter Point in Time DATE for the Report"
- S:$D(EXCL("Elig Date Range")) DIR("B")=$P(EXCL("Elig Date Range"),"^",4)
- S DIR(0)="DO"
- D ^DIR K DIR
- I X["@" K EXCL("Elig Date Range") Q
- Q:(X="")!(X["^")
- W "// ",Y(0)
- S Y1=Y,Y2=Y1-30000
- I $G(Y1)]"" S Y=Y1 D DD^%DT S Y3=Y
- I $G(Y2)]"" S Y=Y2 D DD^%DT S Y4=Y
- S EXCL("Elig Date Range")=$G(Y2)_U_$G(Y4)_U_$G(Y1)_U_$G(Y3)
- Q
- ;
- ASKAGE ; Prompts to get Age Range
- K DIR
- S DIR("A")=" Select age range desired"
- S:$D(EXCL("Age Range")) DIR("B")=$P(EXCL("Age Range"),"^",2)
- S DIR(0)="SO^1:0-17;2:18-64;3:65-95"
- S DIR("L",1)=" Select one of the following:"
- S DIR("L",2)=""
- S DIR("L",3)=" 1 0-17"
- S DIR("L",4)=" 2 18-64"
- S DIR("L")=" 3 65-95"
- D ^DIR K DIR
- I X["@" K EXCL("Age Range") Q
- Q:(X="")!(X["^")
- S EXCL("Age Range")=Y_"^"_Y(0)
- Q
- ;
- ASKELI ; Prompts to get eligibility status
- K DIR
- S DIR("A")=" Select the PATIENT ELIGIBILITY STATUS"
- S:$D(EXCL("Eligibility Status")) DIR("B")=$P(EXCL("Eligibility Status"),"^",2)
- S DIR(0)="SO^1:INDIAN BENEFICIARY PATIENTS;2:NON-BENEFICIARY PATIENTS"
- S DIR("L",1)=" Select one of the following:"
- S DIR("L",2)=""
- S DIR("L",3)=" 1 INDIAN BENEFICIARY PATIENTS"
- S DIR("L")=" 2 NON-BENEFICIARY PATIENTS"
- D ^DIR K DIR
- I X["@" K EXCL("Eligibility Status") Q
- Q:(X="")!(X["^")
- S EXCL("Eligibility Status")=Y_U_Y(0)
- Q
- ;
- ASKPNT ; Get Patient Information for one patient
- K DIR
- S DIR(0)="PO^9000001,:AEM"
- S DIR("A")=" Enter a Patient Name"
- S:$D(EXCL("Specific Patient")) DIR("B")=$P(EXCL("Specific Patient"),U,2)
- D ^DIR K DIR
- I (X="")!(X["^") K EXCL("Alternate Resource") Q
- I X["@" K EXCL("Specific Patient"),EXCL("Alternate Resource") Q
- N PNAME
- S PNAME=$$GET1^DIQ(2,+Y,.01)
- I PNAME'="" S EXCL("Specific Patient")=+Y_U_PNAME
- Q
- ;
- ASKINS ; Get Insurer Information
- K DIR
- S DIR(0)="PO^9999999.18,:AEM"
- S DIR("A")=" Enter an Insurer Name"
- S:$D(EXCL("Specific Insurer")) DIR("B")=$P(EXCL("Specific Insurer"),"^",2)
- D ^DIR
- I (X="")!(X["^") K EXCL("Alternate Resource") Q
- I X["@" K EXCL("Specific Insurer"),EXCL("Alternate Resource") Q
- S EXCL("Specific Insurer")=+Y_U_$$GET1^DIQ(9999999.18,+Y,.01) Q
- Q
- ;
- EXIT ; Clean up variables and exit
- K TAG,EXCL,DIR,X,Y
- K ^TMP("AGAGERP",$J)
- Q
- ;
- QUE ;QUE TO TASKMAN
- K IO("Q")
- S ZTRTN="GO^AGAGERP",ZTDESC="Patient Age Report "
- S ZTSAVE("*")=""
- K ZTSK D ^%ZTLOAD
- I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
- E W !!?5,"Task # ",ZTSK," queued.",!
- H 3
- Q
- AGAGERP ; VNGT/IHS/DLS - Patient Age Specific Report ; April 29, 2010
- +1 ;;7.1;PATIENT REGISTRATION;**8,9**;AUG 25, 2005
- +2 ;
- VAR NEW TAG,EXCL,EXCLS,AGLINE,AGINS
- +1 KILL ^TMP("AGAGERP",$JOB)
- +2 ;
- +3 ;Initialize Variables
- +4 ;
- +5 DO INTRO
- PLOOP ; For looping back to paremeter menu.
- +1 DO GETPARAM
- +2 IF '$DATA(EXCL)
- GOTO EXIT
- +3 IF ($GET(EXCL("Elig Date Range"))'="")&($GET(EXCL("Alternate Resource"))="")
- Begin DoDot:1
- +4 WRITE !!," ============================================================================"
- +5 WRITE !," An Alternate Resource of 'MEDICARE', 'MEDICAID', 'PRIVATE INSURANCE',"
- +6 WRITE !," 'SPECIFIC INSURER', 'WORKMEN'S COMP', 'PRIVATE & WORKMEN'S COMP', or 'CHIP'"
- +7 WRITE !," must be selected when entering a Point in Time date. Patients with eligibil-"
- +8 WRITE !," ity up to 3 years before the date entered will be included in the selection"
- +9 WRITE !," process."
- +10 WRITE !," ============================================================================",!
- +11 KILL DIR
- DO RTRN^AG
- End DoDot:1
- GOTO PLOOP
- DEV ;
- +1 SET %ZIS="QA"
- +2 DO ^%ZIS
- +3 IF POP
- NEW IOP
- SET IOP=ION
- DO ^%ZIS
- QUIT
- +4 IF $GET(IO("Q"))
- DO QUE
- DO HOME^%ZIS
- QUIT
- +5 USE IO
- +6 DO GO
- +7 DO ^%ZISC
- +8 DO HOME^%ZIS
- +9 QUIT
- GO ; Proceed with processing
- +1 DO GETDATA^AGAGERP1
- +2 DO PRINT^AGAGERP2
- +3 GOTO EXIT
- +4 QUIT
- +5 ;
- INTRO ; Introduction Screen
- +1 WRITE !!!," NOTE: To run this report you must select at least one parameter."
- +2 WRITE !," If no parameters are selected, you will return to the reports menu.",!
- +3 DO RTRN^AG
- +4 QUIT
- +5 ;
- GETPARAM ; Main Report Driver
- +1 WRITE @IOF
- +2 IF $DATA(EXCL)
- DO EXCLIST
- +3 NEW TAG,X,Y
- +4 KILL DIR
- +5 SET DIR("A")=" Select ONE or MORE of the above EXCLUSION PARAMETERS"
- +6 SET DIR(0)="SO^1:LOCATION;2:ALTERNATE RESOURCE;3:DATE;4:AGE RANGE;5:ELIGIBILITY STATUS"
- +7 SET DIR("L",1)=" Select one of the following:"
- +8 SET DIR("L",2)=""
- +9 SET DIR("L",3)=" 1 LOCATION"
- +10 SET DIR("L",4)=" 2 ALTERNATE RESOURCE"
- +11 SET DIR("L",5)=" 3 DATE RANGE"
- +12 SET DIR("L",6)=" 4 AGE RANGE"
- +13 SET DIR("L")=" 5 ELIGIBILITY STATUS"
- +14 DO ^DIR
- KILL DIR
- +15 IF Y=""
- QUIT
- +16 IF Y["^"
- KILL EXCL
- QUIT
- +17 SET TAG="ASK"_$EXTRACT(Y(0),1,3)
- +18 DO @TAG
- +19 KILL TAG
- +20 DO GETPARAM
- +21 QUIT
- +22 ;
- EXCLIST ; List Exclusion Paramenters selected so far.
- +1 WRITE !!!
- +2 WRITE " EXCLUSION PARAMETERS Currently in Effect for RESTRICTING the EXPORT to:"
- +3 WRITE !," ======================================================================="
- +4 NEW EXCLS,AGDOTS,AGDOTLN
- +5 SET EXCLS=""
- FOR
- SET EXCLS=$ORDER(EXCL(EXCLS))
- IF EXCLS=""
- QUIT
- Begin DoDot:1
- +6 WRITE !," - ",EXCLS
- +7 SET AGDOTS=22-$LENGTH(EXCLS)
- +8 SET AGDOTLN=""
- +9 SET $PIECE(AGDOTLN,".",AGDOTS)=""
- +10 WRITE AGDOTLN,": ",$PIECE($GET(EXCL(EXCLS)),U,2)
- +11 IF EXCLS="Visit Date Range"
- WRITE " - ",$PIECE($GET(EXCL(EXCLS)),U,4)
- +12 IF EXCLS="Elig Date Range"
- WRITE " - ",$PIECE($GET(EXCL(EXCLS)),U,4)
- End DoDot:1
- +13 QUIT
- +14 ;
- ASKLOC ; Prompts to get location
- +1 KILL DIR
- +2 SET DIR(0)="PO^9999999.06,DUZ(2),:AEM"
- +3 SET DIR("A")=" Enter a location"
- +4 IF $DATA(EXCL("Location"))
- SET DIR("B")=$PIECE(EXCL("Location"),U,2)
- +5 DO ^DIR
- KILL DIR
- +6 IF X["@"
- KILL EXCL("Location")
- QUIT
- +7 IF (X="")!(X["^")
- QUIT
- +8 SET EXCL("Location")=+Y_U_$$GET1^DIQ(4,+Y,.01)
- +9 QUIT
- +10 ;
- ASKALT ; Prompts to get Alt Resource
- +1 NEW X,Y
- +2 KILL DIR
- +3 SET DIR("A")=" Select TYPE of ALTERNATE RESOURCE to Display"
- +4 IF $DATA(EXCL("Alternate Resource"))
- SET DIR("B")=$PIECE(EXCL("Alternate Resource"),"^",2)
- +5 SET DIR(0)="SO^1:MEDICARE;2:MEDICAID;3:PRIVATE INSURANCE;4:SPECIFIC INSURER;5:SPECIFIC PATIENT;6:WORKMEN'S COMP;7:PRIVATE + WORKMEN'S COMP;8:CHIP;9:NO RESOURCES"
- +6 SET DIR("L",1)=" Select one of the following:"
- +7 SET DIR("L",2)=""
- +8 SET DIR("L",3)=" 1 MEDICARE"
- +9 SET DIR("L",4)=" 2 MEDICAID"
- +10 SET DIR("L",5)=" 3 PRIVATE INSURANCE"
- +11 SET DIR("L",6)=" 4 SPECIFIC INSURER"
- +12 SET DIR("L",7)=" 5 SPECIFIC PATIENT"
- +13 SET DIR("L",8)=" 6 WORKMEN'S COMP"
- +14 SET DIR("L",9)=" 7 PRIVATE + WORKMEN'S COMP"
- +15 SET DIR("L")=" 8 CHIP"
- +16 DO ^DIR
- KILL DIR
- +17 IF X=4
- SET EXCL("Alternate Resource")="4^SPECIFIC INSURER"
- DO ASKINS
- QUIT
- +18 IF X=5
- DO ASKPNT
- QUIT
- +19 IF X["@"
- KILL EXCL("Alternate Resource")
- QUIT
- +20 IF (X="")!(X["^")
- QUIT
- +21 SET EXCL("Alternate Resource")=Y_U_Y(0)
- +22 QUIT
- +23 ;
- ASKDAT ; Prompts to get date type
- +1 NEW TAG
- +2 KILL DIR
- +3 SET DIR("A")=" Select type of Date Desired"
- +4 SET DIR(0)="SO^1:Visit Date;2:Point in Time"
- +5 SET DIR("L",1)=" 1 Visit Date"
- +6 SET DIR("L")=" 2 Point in Time"
- +7 DO ^DIR
- KILL DIR
- +8 IF (X="")!(X["^")!(X["@")
- QUIT
- +9 SET TAG="ASK"_$EXTRACT(Y(0),1,3)
- +10 IF Y=1
- SET TAG="ASKVIS"
- +11 IF Y=2
- SET TAG="ASKPOI"
- +12 DO @TAG
- +13 KILL TAG
- +14 QUIT
- +15 ;
- ASKVIS ; Prompts to get Visits within date range
- +1 KILL DIR
- +2 KILL EXCL("Elig Date Range")
- +3 NEW Y1,Y2,Y3,Y4
- +4 WRITE !!," ============ Entry of VISIT DATE Range ===========",!
- +5 SET DIR("A")=" Enter STARTING VISIT DATE for the Report"
- +6 IF $DATA(EXCL("Visit Date Range"))
- SET DIR("B")=$PIECE(EXCL("Visit Date Range"),"^",2)
- +7 SET DIR(0)="DO"
- +8 DO ^DIR
- KILL DIR
- +9 IF X["@"
- KILL EXCL("Visit Date Range")
- QUIT
- +10 IF (X="")!(X["^")!(X["@")
- QUIT
- +11 WRITE "// ",Y(0)
- +12 SET Y1=Y
- +13 IF $GET(Y1)]""
- SET Y=Y1
- DO DD^%DT
- SET Y2=Y
- +14 SET DIR("A")=" Enter ENDING DATE for the Report"
- +15 IF $DATA(EXCL("Visit Date Range"))
- SET DIR("B")=$PIECE(EXCL("Visit Date Range"),"^",4)
- +16 SET DIR(0)="DO"
- +17 DO ^DIR
- KILL DIR
- +18 IF X["@"
- KILL EXCL("Visit Date Range")
- QUIT
- +19 IF (X="")!(X["^")!(X["@")
- QUIT
- +20 WRITE "// ",Y(0)
- +21 SET Y3=Y
- DO DD^%DT
- SET Y4=4
- +22 IF Y3<Y1
- Begin DoDot:1
- +23 WRITE !!," To Date must be after From Date. Please try again."
- +24 KILL EXCL("Visit Date Range")
- +25 DO ASKVIS
- End DoDot:1
- QUIT
- +26 IF $GET(Y3)]""
- SET Y=Y3
- DO DD^%DT
- SET Y4=Y
- +27 SET EXCL("Visit Date Range")=$GET(Y1)_U_$GET(Y2)_U_$GET(Y3)_U_$GET(Y4)
- +28 QUIT
- +29 ;
- ASKPOI ; Prompt for Elig date
- +1 KILL DIR
- +2 KILL EXCL("Visit Date Range")
- +3 NEW Y1,Y2,Y3,Y4
- +4 WRITE !!," =========== Point in Time Date for Alternate Resource Eligibility:============"
- +5 WRITE !," An Alternate Resource of 'MEDICARE', 'MEDICAID', 'PRIVATE INSURANCE',"
- +6 WRITE !," 'SPECIFIC INSURER', 'WORKMEN'S COMP', 'PRIVATE & WORKMEN'S COMP', or 'CHIP'"
- +7 WRITE !," must be selected when entering a Point in Time date. Patients with eligibil-"
- +8 WRITE !," ity up to 3 years before the date entered will be included in the selection"
- +9 WRITE !," process."
- +10 WRITE !," ===============================================================================",!
- +11 SET DIR("A")=" Enter Point in Time DATE for the Report"
- +12 IF $DATA(EXCL("Elig Date Range"))
- SET DIR("B")=$PIECE(EXCL("Elig Date Range"),"^",4)
- +13 SET DIR(0)="DO"
- +14 DO ^DIR
- KILL DIR
- +15 IF X["@"
- KILL EXCL("Elig Date Range")
- QUIT
- +16 IF (X="")!(X["^")
- QUIT
- +17 WRITE "// ",Y(0)
- +18 SET Y1=Y
- SET Y2=Y1-30000
- +19 IF $GET(Y1)]""
- SET Y=Y1
- DO DD^%DT
- SET Y3=Y
- +20 IF $GET(Y2)]""
- SET Y=Y2
- DO DD^%DT
- SET Y4=Y
- +21 SET EXCL("Elig Date Range")=$GET(Y2)_U_$GET(Y4)_U_$GET(Y1)_U_$GET(Y3)
- +22 QUIT
- +23 ;
- ASKAGE ; Prompts to get Age Range
- +1 KILL DIR
- +2 SET DIR("A")=" Select age range desired"
- +3 IF $DATA(EXCL("Age Range"))
- SET DIR("B")=$PIECE(EXCL("Age Range"),"^",2)
- +4 SET DIR(0)="SO^1:0-17;2:18-64;3:65-95"
- +5 SET DIR("L",1)=" Select one of the following:"
- +6 SET DIR("L",2)=""
- +7 SET DIR("L",3)=" 1 0-17"
- +8 SET DIR("L",4)=" 2 18-64"
- +9 SET DIR("L")=" 3 65-95"
- +10 DO ^DIR
- KILL DIR
- +11 IF X["@"
- KILL EXCL("Age Range")
- QUIT
- +12 IF (X="")!(X["^")
- QUIT
- +13 SET EXCL("Age Range")=Y_"^"_Y(0)
- +14 QUIT
- +15 ;
- ASKELI ; Prompts to get eligibility status
- +1 KILL DIR
- +2 SET DIR("A")=" Select the PATIENT ELIGIBILITY STATUS"
- +3 IF $DATA(EXCL("Eligibility Status"))
- SET DIR("B")=$PIECE(EXCL("Eligibility Status"),"^",2)
- +4 SET DIR(0)="SO^1:INDIAN BENEFICIARY PATIENTS;2:NON-BENEFICIARY PATIENTS"
- +5 SET DIR("L",1)=" Select one of the following:"
- +6 SET DIR("L",2)=""
- +7 SET DIR("L",3)=" 1 INDIAN BENEFICIARY PATIENTS"
- +8 SET DIR("L")=" 2 NON-BENEFICIARY PATIENTS"
- +9 DO ^DIR
- KILL DIR
- +10 IF X["@"
- KILL EXCL("Eligibility Status")
- QUIT
- +11 IF (X="")!(X["^")
- QUIT
- +12 SET EXCL("Eligibility Status")=Y_U_Y(0)
- +13 QUIT
- +14 ;
- ASKPNT ; Get Patient Information for one patient
- +1 KILL DIR
- +2 SET DIR(0)="PO^9000001,:AEM"
- +3 SET DIR("A")=" Enter a Patient Name"
- +4 IF $DATA(EXCL("Specific Patient"))
- SET DIR("B")=$PIECE(EXCL("Specific Patient"),U,2)
- +5 DO ^DIR
- KILL DIR
- +6 IF (X="")!(X["^")
- KILL EXCL("Alternate Resource")
- QUIT
- +7 IF X["@"
- KILL EXCL("Specific Patient"),EXCL("Alternate Resource")
- QUIT
- +8 NEW PNAME
- +9 SET PNAME=$$GET1^DIQ(2,+Y,.01)
- +10 IF PNAME'=""
- SET EXCL("Specific Patient")=+Y_U_PNAME
- +11 QUIT
- +12 ;
- ASKINS ; Get Insurer Information
- +1 KILL DIR
- +2 SET DIR(0)="PO^9999999.18,:AEM"
- +3 SET DIR("A")=" Enter an Insurer Name"
- +4 IF $DATA(EXCL("Specific Insurer"))
- SET DIR("B")=$PIECE(EXCL("Specific Insurer"),"^",2)
- +5 DO ^DIR
- +6 IF (X="")!(X["^")
- KILL EXCL("Alternate Resource")
- QUIT
- +7 IF X["@"
- KILL EXCL("Specific Insurer"),EXCL("Alternate Resource")
- QUIT
- +8 SET EXCL("Specific Insurer")=+Y_U_$$GET1^DIQ(9999999.18,+Y,.01)
- QUIT
- +9 QUIT
- +10 ;
- EXIT ; Clean up variables and exit
- +1 KILL TAG,EXCL,DIR,X,Y
- +2 KILL ^TMP("AGAGERP",$JOB)
- +3 QUIT
- +4 ;
- QUE ;QUE TO TASKMAN
- +1 KILL IO("Q")
- +2 SET ZTRTN="GO^AGAGERP"
- SET ZTDESC="Patient Age Report "
- +3 SET ZTSAVE("*")=""
- +4 KILL ZTSK
- DO ^%ZTLOAD
- +5 IF $DATA(ZTSK)[0
- WRITE !!?5,"Report Cancelled!"
- +6 IF '$TEST
- WRITE !!?5,"Task # ",ZTSK," queued.",!
- +7 HANG 3
- +8 QUIT
