Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGACAL

AGACAL.m

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