- AGACAL ; IHS/OIT/NKD - PRINT AN IHS ELIGIBILITY LETTER ; FEBRUARY 10, 2014
- ;;7.1;PATIENT REGISTRATION;**11**;AUG 25, 2005;Build 1
- EN ;EP
- N AGTEXT,AGCNT
- F AGCNT=1:1 S AGTEXT=$P($T(HDR+AGCNT^AGACAL),";;",2) Q:AGTEXT="END" D
- . W !,AGTEXT
- I '$$KEYCHK() D EXIT Q
- SELPT ;SELECT PATIENT
- N AGDFN,AGDUZ,AGDUZ2
- D PTLK^AG
- I '$D(DFN)!'$D(DUZ(2)) D EXIT Q
- I '$$ELCHK(DFN) D EXIT Q
- S AGDFN=DFN,AGDUZ=DUZ,AGDUZ2=DUZ(2)
- D ZIS
- D EXIT
- Q
- ;
- KEYCHK() ;EP - CHECK AGZACA SIGN KEY
- N AGSIGN
- S AGSIGN=$O(^XUSEC("AGZACA SIGN",""))
- I AGSIGN']"" W !,"<AG SIGN SECURITY KEY NOT ASSIGNED>" K DIR S DIR(0)="EO",DIR("A")="Press Enter to continue." D ^DIR K DIR Q 0
- I $O(^XUSEC("AGZACA SIGN",AGSIGN))]"" W !,"<AG SIGN SECURITY KEY ASSIGNED TO MORE THAN ONE USER>" K DIR S DIR(0)="EO",DIR("A")="Press Enter to continue." D ^DIR K DIR Q 0
- Q 1
- ;
- ELCHK(AGDFN) ;EP - CHECK PT ELIGIBILITY
- Q:'$D(AGDFN)
- N AGBEN,AGELIG,AGRES
- S AGBEN=$S("INDIAN/ALASKA NATIVE"=$$BEN^AUPNPAT(AGDFN,"E"):1,1:0)
- S AGELIG=$S("DC"[$$ELIGSTAT^AUPNPAT(AGDFN,"I"):1,1:0)
- S AGRES=$S(AGBEN+AGELIG=2:1,1:0)
- I 'AGBEN,AGELIG D
- . W !!,">>> Warning the patient you have selected is a NON-INDIAN BENEFICIARY,"
- . W !,">>> but listed as eligible for services."
- . W !,">>> Are you sure you want to continue to print?"
- . K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="PROCEED TO PRINT LETTER ANYWAY (Y/N)" D ^DIR
- . S:Y=1 AGRES=1
- I 'AGBEN,'AGELIG D
- . W !!,">>> Warning the patient you have selected is not eligible based on the following information:"
- . W !," CLASSIFICATION/BENEFICIARY : "_$$BEN^AUPNPAT(AGDFN,"E")
- . W !," ELIGIBILITY STATUS : "_$$ELIGSTAT^AUPNPAT(AGDFN,"E"),!
- K DIR S DIR(0)="EO",DIR("A")="Press Enter to continue." D ^DIR K DIR
- Q AGRES
- ;
- ZIS ;DEVICE
- S XBRP="PRINT^AGACAL",XBRC="",XBRX="EXIT^AGACAL",XBNS="AGDFN;AGDUZ;AGDUZ2"
- D ^XBDBQUE
- D EXIT
- Q
- ;
- EXIT ;EP
- K DFN,AGDFN,AGDUZ,AGDUZ2,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AGOVER
- D ^XBFMK
- Q
- ;
- PRINT ;EP - PRINT ACA LETTER
- Q:'$D(AGDFN)!'$D(AGDUZ)!'$D(AGDUZ2)
- Q:'$D(^DPT(AGDFN,0))!'$D(^AUPNPAT(AGDFN,0))
- ; CREATE LOG ENTRY
- N FDA,NEWIEN,DINUM,AGCNT,AGCNT2,AGTEXT,AGTMP
- N AGDT,AGLI,AGDTE,AGNAME,AGADD1,AGADD2,AGDOB,AGSSN,AGDUZN,AGDUZAN,AGDUZPH,AGSIGN,AGUID
- S AGDT=$$DT^XLFDT()
- F DINUM=+$P(^AGACAL(0),"^",3):1 Q:DINUM>0&'$D(^AGACAL(DINUM,0))
- S NEWIEN(1)=DINUM
- S FDA(9009063.5,"+1,",.01)=AGDFN
- S FDA(9009063.5,"+1,",.03)=AGDUZ
- S FDA(9009063.5,"+1,",.04)=AGDT
- S FDA(9009063.5,"+1,",.05)=$$NOW^XLFDT()
- S FDA(9009063.5,"+1,",.06)=AGDUZ2
- D UPDATE^DIE(,"FDA","NEWIEN")
- S AGLI=NEWIEN(1)
- ; SETUP LETTER PRINTING VARIABLES
- S AGDTE=$$FMTE^XLFDT(AGDT) ;"<Date>"
- S AGNAME=$$NAMEFMT^XLFNAME($$GET1^DIQ(2,AGDFN,.01),"G","M") ;"<First Middle Last Name>"
- S AGADD1=$$GET1^DIQ(2,AGDFN,.111) ;"<Address line 1>"
- S AGADD2=$$GET1^DIQ(2,AGDFN,.114)_", "_$$GET1^DIQ(5,$$GET1^DIQ(2,AGDFN,.115,"I"),1)_" "_$$GET1^DIQ(2,AGDFN,.116) ;"<City, State Zip>"
- S AGDOB=$$GET1^DIQ(2,AGDFN,.03,"E") ;"<Date of Birth>"
- S AGSSN=$$GET1^DIQ(9000001,AGDFN,1107.3) ;"<Last 4 of SSN>"
- S AGDUZN=$$TITLE^XLFSTR($$GET1^DIQ(4,AGDUZ2,.01)) ;"<Facility Name>"
- S AGDUZAN=$$TITLE^XLFSTR($$GET1^DIQ(9999999.21,$$GET1^DIQ(9999999.06,AGDUZ2,.04,"I"),.03)) ;"<Area Prefix/Region>"
- S AGDUZPH=$$GET1^DIQ(9999999.06,AGDUZ2,.13) ;"<Facility Phone Number>"
- S AGSIGN=$O(^XUSEC("AGZACA SIGN","")),AGSIGN=$$NAMEFMT^XLFNAME($$GET1^DIQ(200,AGSIGN,.01),"G","M")_", "_$$GET1^DIQ(200,AGSIGN,8) ;"<Signing User, Title>"
- S AGUID=$$ENC^AGACALV(AGDUZ,AGDT,AGDFN,AGLI) ;"<Unique Identifier>"
- ; PRINT LETTER
- F AGCNT=1:1 S AGTEXT=$P($T(BODY+AGCNT^AGACAL),";;",2) Q:AGTEXT="END" D
- . W !
- . F AGCNT2=1:1:$L(AGTEXT,"^") S AGTMP=$P(AGTEXT,"^",AGCNT2) D
- . . I $E(AGTMP,1,1)'="@" W AGTMP
- . . E W @($P(AGTMP,"@",2))
- ; UPDATE LOG ENTRY WITH UID
- K FDA
- S FDA(9009063.5,AGLI_",",.02)=AGUID
- D UPDATE^DIE(,"FDA")
- ; END
- I $E(IOST)="C",IO=IO(0) W ! K DIR S DIR(0)="EO",DIR("A")="End of Report. Press Enter." D ^DIR K DIR
- D EOJ
- Q
- EOJ ;
- D ^XBFMK
- K AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
- K FDA,NEWIEN,DINUM,AGCNT,AGCNT2,AGTEXT,AGTMP
- K AGDT,AGLI,AGDTE,AGNAME,AGADD1,AGADD2,AGDOB,AGSSN,AGDUZN,AGDUZAN,AGDUZPH,AGSIGN,AGUID
- K N,%,T,F,X,Y,B,C,E,F,H,J,L,N,P,T,W
- Q
- HDR ;HEADER TEXT
- ;;
- ;;Printing of this letter is restricted to Individuals who are eligible for
- ;;services through an Indian health care provider as defined in 42 CFR 447.50
- ;;or is eligible for services through the Indian Health Service in accordance
- ;;with 25 USC 1680c(a), (b), or (d)(3).
- ;;
- ;;END
- BODY ;BODY TEXT
- ;;@AGDTE
- ;;
- ;;RE: ^@AGNAME
- ;; ^@AGADD1
- ;; ^@AGADD2
- ;;
- ;;Dear Federal or State Marketplace,
- ;;
- ;;We have received a request to verify eligibility for Indian
- ;;Health Service (IHS) coverage for ^@AGNAME^.
- ;;
- ;;Upon review of our local facility data, we confirm that this
- ;;individual is an Indian eligible for services through an
- ;;Indian health care provider as defined by 42 CFR 447.50 or is
- ;;eligible for services through the Indian Health Service in
- ;;accordance with 25 USC 1680c(a), (b), or (d)(3). Eligibility
- ;;for such services under 42 CFR Part 136 has been verified at
- ;;the ^@AGDUZN
- ;;within the Indian Health Service ^@AGDUZAN^ Area.
- ;;
- ;;If you have any questions, please contact us at: ^@AGDUZPH
- ;;
- ;;Sincerely,
- ;;
- ;;
- ;;
- ;;
- ;;@AGSIGN
- ;;@AGDUZN
- ;;@AGDUZAN^ Area
- ;;
- ;;
- ;;
- ;;UNIQUE IDENTIFIERS:
- ;;DOB: ^@AGDOB
- ;;SSN: ^@AGSSN
- ;;@AGUID
- ;;END
- AGACAL ; IHS/OIT/NKD - PRINT AN IHS ELIGIBILITY LETTER ; FEBRUARY 10, 2014
- +1 ;;7.1;PATIENT REGISTRATION;**11**;AUG 25, 2005;Build 1
- EN ;EP
- +1 NEW AGTEXT,AGCNT
- +2 FOR AGCNT=1:1
- SET AGTEXT=$PIECE($TEXT(HDR+AGCNT^AGACAL),";;",2)
- IF AGTEXT="END"
- QUIT
- Begin DoDot:1
- +3 WRITE !,AGTEXT
- End DoDot:1
- +4 IF '$$KEYCHK()
- DO EXIT
- QUIT
- SELPT ;SELECT PATIENT
- +1 NEW AGDFN,AGDUZ,AGDUZ2
- +2 DO PTLK^AG
- +3 IF '$DATA(DFN)!'$DATA(DUZ(2))
- DO EXIT
- QUIT
- +4 IF '$$ELCHK(DFN)
- DO EXIT
- QUIT
- +5 SET AGDFN=DFN
- SET AGDUZ=DUZ
- SET AGDUZ2=DUZ(2)
- +6 DO ZIS
- +7 DO EXIT
- +8 QUIT
- +9 ;
- KEYCHK() ;EP - CHECK AGZACA SIGN KEY
- +1 NEW AGSIGN
- +2 SET AGSIGN=$ORDER(^XUSEC("AGZACA SIGN",""))
- +3 IF AGSIGN']""
- WRITE !,"<AG SIGN SECURITY KEY NOT ASSIGNED>"
- KILL DIR
- SET DIR(0)="EO"
- SET DIR("A")="Press Enter to continue."
- DO ^DIR
- KILL DIR
- QUIT 0
- +4 IF $ORDER(^XUSEC("AGZACA SIGN",AGSIGN))]""
- WRITE !,"<AG SIGN SECURITY KEY ASSIGNED TO MORE THAN ONE USER>"
- KILL DIR
- SET DIR(0)="EO"
- SET DIR("A")="Press Enter to continue."
- DO ^DIR
- KILL DIR
- QUIT 0
- +5 QUIT 1
- +6 ;
- ELCHK(AGDFN) ;EP - CHECK PT ELIGIBILITY
- +1 IF '$DATA(AGDFN)
- QUIT
- +2 NEW AGBEN,AGELIG,AGRES
- +3 SET AGBEN=$SELECT("INDIAN/ALASKA NATIVE"=$$BEN^AUPNPAT(AGDFN,"E"):1,1:0)
- +4 SET AGELIG=$SELECT("DC"[$$ELIGSTAT^AUPNPAT(AGDFN,"I"):1,1:0)
- +5 SET AGRES=$SELECT(AGBEN+AGELIG=2:1,1:0)
- +6 IF 'AGBEN
- IF AGELIG
- Begin DoDot:1
- +7 WRITE !!,">>> Warning the patient you have selected is a NON-INDIAN BENEFICIARY,"
- +8 WRITE !,">>> but listed as eligible for services."
- +9 WRITE !,">>> Are you sure you want to continue to print?"
- +10 KILL DIR
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="PROCEED TO PRINT LETTER ANYWAY (Y/N)"
- DO ^DIR
- +11 IF Y=1
- SET AGRES=1
- End DoDot:1
- +12 IF 'AGBEN
- IF 'AGELIG
- Begin DoDot:1
- +13 WRITE !!,">>> Warning the patient you have selected is not eligible based on the following information:"
- +14 WRITE !," CLASSIFICATION/BENEFICIARY : "_$$BEN^AUPNPAT(AGDFN,"E")
- +15 WRITE !," ELIGIBILITY STATUS : "_$$ELIGSTAT^AUPNPAT(AGDFN,"E"),!
- End DoDot:1
- +16 KILL DIR
- SET DIR(0)="EO"
- SET DIR("A")="Press Enter to continue."
- DO ^DIR
- KILL DIR
- +17 QUIT AGRES
- +18 ;
- ZIS ;DEVICE
- +1 SET XBRP="PRINT^AGACAL"
- SET XBRC=""
- SET XBRX="EXIT^AGACAL"
- SET XBNS="AGDFN;AGDUZ;AGDUZ2"
- +2 DO ^XBDBQUE
- +3 DO EXIT
- +4 QUIT
- +5 ;
- EXIT ;EP
- +1 KILL DFN,AGDFN,AGDUZ,AGDUZ2,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AGOVER
- +2 DO ^XBFMK
- +3 QUIT
- +4 ;
- PRINT ;EP - PRINT ACA LETTER
- +1 IF '$DATA(AGDFN)!'$DATA(AGDUZ)!'$DATA(AGDUZ2)
- QUIT
- +2 IF '$DATA(^DPT(AGDFN,0))!'$DATA(^AUPNPAT(AGDFN,0))
- QUIT
- +3 ; CREATE LOG ENTRY
- +4 NEW FDA,NEWIEN,DINUM,AGCNT,AGCNT2,AGTEXT,AGTMP
- +5 NEW AGDT,AGLI,AGDTE,AGNAME,AGADD1,AGADD2,AGDOB,AGSSN,AGDUZN,AGDUZAN,AGDUZPH,AGSIGN,AGUID
- +6 SET AGDT=$$DT^XLFDT()
- +7 FOR DINUM=+$PIECE(^AGACAL(0),"^",3):1
- IF DINUM>0&'$DATA(^AGACAL(DINUM,0))
- QUIT
- +8 SET NEWIEN(1)=DINUM
- +9 SET FDA(9009063.5,"+1,",.01)=AGDFN
- +10 SET FDA(9009063.5,"+1,",.03)=AGDUZ
- +11 SET FDA(9009063.5,"+1,",.04)=AGDT
- +12 SET FDA(9009063.5,"+1,",.05)=$$NOW^XLFDT()
- +13 SET FDA(9009063.5,"+1,",.06)=AGDUZ2
- +14 DO UPDATE^DIE(,"FDA","NEWIEN")
- +15 SET AGLI=NEWIEN(1)
- +16 ; SETUP LETTER PRINTING VARIABLES
- +17 ;"<Date>"
- SET AGDTE=$$FMTE^XLFDT(AGDT)
- +18 ;"<First Middle Last Name>"
- SET AGNAME=$$NAMEFMT^XLFNAME($$GET1^DIQ(2,AGDFN,.01),"G","M")
- +19 ;"<Address line 1>"
- SET AGADD1=$$GET1^DIQ(2,AGDFN,.111)
- +20 ;"<City, State Zip>"
- SET AGADD2=$$GET1^DIQ(2,AGDFN,.114)_", "_$$GET1^DIQ(5,$$GET1^DIQ(2,AGDFN,.115,"I"),1)_" "_$$GET1^DIQ(2,AGDFN,.116)
- +21 ;"<Date of Birth>"
- SET AGDOB=$$GET1^DIQ(2,AGDFN,.03,"E")
- +22 ;"<Last 4 of SSN>"
- SET AGSSN=$$GET1^DIQ(9000001,AGDFN,1107.3)
- +23 ;"<Facility Name>"
- SET AGDUZN=$$TITLE^XLFSTR($$GET1^DIQ(4,AGDUZ2,.01))
- +24 ;"<Area Prefix/Region>"
- SET AGDUZAN=$$TITLE^XLFSTR($$GET1^DIQ(9999999.21,$$GET1^DIQ(9999999.06,AGDUZ2,.04,"I"),.03))
- +25 ;"<Facility Phone Number>"
- SET AGDUZPH=$$GET1^DIQ(9999999.06,AGDUZ2,.13)
- +26 ;"<Signing User, Title>"
- SET AGSIGN=$ORDER(^XUSEC("AGZACA SIGN",""))
- SET AGSIGN=$$NAMEFMT^XLFNAME($$GET1^DIQ(200,AGSIGN,.01),"G","M")_", "_$$GET1^DIQ(200,AGSIGN,8)
- +27 ;"<Unique Identifier>"
- SET AGUID=$$ENC^AGACALV(AGDUZ,AGDT,AGDFN,AGLI)
- +28 ; PRINT LETTER
- +29 FOR AGCNT=1:1
- SET AGTEXT=$PIECE($TEXT(BODY+AGCNT^AGACAL),";;",2)
- IF AGTEXT="END"
- QUIT
- Begin DoDot:1
- +30 WRITE !
- +31 FOR AGCNT2=1:1:$LENGTH(AGTEXT,"^")
- SET AGTMP=$PIECE(AGTEXT,"^",AGCNT2)
- Begin DoDot:2
- +32 IF $EXTRACT(AGTMP,1,1)'="@"
- WRITE AGTMP
- +33 IF '$TEST
- WRITE @($PIECE(AGTMP,"@",2))
- End DoDot:2
- End DoDot:1
- +34 ; UPDATE LOG ENTRY WITH UID
- +35 KILL FDA
- +36 SET FDA(9009063.5,AGLI_",",.02)=AGUID
- +37 DO UPDATE^DIE(,"FDA")
- +38 ; END
- +39 IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- WRITE !
- KILL DIR
- SET DIR(0)="EO"
- SET DIR("A")="End of Report. Press Enter."
- DO ^DIR
- KILL DIR
- +40 DO EOJ
- +41 QUIT
- EOJ ;
- +1 DO ^XBFMK
- +2 KILL AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
- +3 KILL FDA,NEWIEN,DINUM,AGCNT,AGCNT2,AGTEXT,AGTMP
- +4 KILL AGDT,AGLI,AGDTE,AGNAME,AGADD1,AGADD2,AGDOB,AGSSN,AGDUZN,AGDUZAN,AGDUZPH,AGSIGN,AGUID
- +5 KILL N,%,T,F,X,Y,B,C,E,F,H,J,L,N,P,T,W
- +6 QUIT
- HDR ;HEADER TEXT
- +1 ;;
- +2 ;;Printing of this letter is restricted to Individuals who are eligible for
- +3 ;;services through an Indian health care provider as defined in 42 CFR 447.50
- +4 ;;or is eligible for services through the Indian Health Service in accordance
- +5 ;;with 25 USC 1680c(a), (b), or (d)(3).
- +6 ;;
- +7 ;;END
- BODY ;BODY TEXT
- +1 ;;@AGDTE
- +2 ;;
- +3 ;;RE: ^@AGNAME
- +4 ;; ^@AGADD1
- +5 ;; ^@AGADD2
- +6 ;;
- +7 ;;Dear Federal or State Marketplace,
- +8 ;;
- +9 ;;We have received a request to verify eligibility for Indian
- +10 ;;Health Service (IHS) coverage for ^@AGNAME^.
- +11 ;;
- +12 ;;Upon review of our local facility data, we confirm that this
- +13 ;;individual is an Indian eligible for services through an
- +14 ;;Indian health care provider as defined by 42 CFR 447.50 or is
- +15 ;;eligible for services through the Indian Health Service in
- +16 ;;accordance with 25 USC 1680c(a), (b), or (d)(3). Eligibility
- +17 ;;for such services under 42 CFR Part 136 has been verified at
- +18 ;;the ^@AGDUZN
- +19 ;;within the Indian Health Service ^@AGDUZAN^ Area.
- +20 ;;
- +21 ;;If you have any questions, please contact us at: ^@AGDUZPH
- +22 ;;
- +23 ;;Sincerely,
- +24 ;;
- +25 ;;
- +26 ;;
- +27 ;;
- +28 ;;@AGSIGN
- +29 ;;@AGDUZN
- +30 ;;@AGDUZAN^ Area
- +31 ;;
- +32 ;;
- +33 ;;
- +34 ;;UNIQUE IDENTIFIERS:
- +35 ;;DOB: ^@AGDOB
- +36 ;;SSN: ^@AGSSN
- +37 ;;@AGUID
- +38 ;;END