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
