AGACALV.m

AGACALV ; IHS/OIT/NKD - VERIFY 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^AGACALV),";;",2) Q:AGTEXT="END"  D

 . W !,AGTEXT

 D MAIN

 Q

 ;

MAIN ;MAIN PROCESSING

 N AGQUIT

 S AGQUIT=0

 F  Q:AGQUIT  D

 . N DIR,DTOUT,DUOUT,DIRUT,DIROUT,Y,AGCODE,AGRES

 . S DIR(0)="FOU^21"

 . S DIR("A")="ENTER THE UNIQUE IDENTIFIER CODE (MINIMUM 21 DIGITS)"

 . D ^DIR

 . I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S AGQUIT=1 Q

 . S AGCODE=Y

 . S AGRES=$$DEC(AGCODE)

 . W !!,?16,"LETTER",?35,"RPMS",?60,"RESULTS"

 . W !,?16,"------------",?35,"------------",?60,"------------"

 . I '$$P1(+AGRES) D PROMPT Q

 . I '$$P2(+AGRES,$P(AGRES,U,2))

 . I '$$P3(+AGRES,$P(AGRES,U,3))

 . D PROMPT

 Q

 ;

PROMPT ;ENTER TO CONTINUE

 K DIR S DIR(0)="EO",DIR("A")="Press Enter to continue." D ^DIR K DIR Q

 ;

P1(AGREC) ;EP - CHECK RECORD NUMBER

 N AGRES

 ;

 S AGRES=$S($D(^AGACAL(AGREC,0)):AGREC_U_"PASSED",1:"0^FAILED ***")

 ;

 W !,"RECORD NUMBER: ",?16,AGREC,?30,"...",?35,+AGRES,?60,$P(AGRES,U,2)

 ;

 Q $S(+AGRES:1,1:0)

 ;

P2(AGREC,AGUID) ;EP - CHECK USER/DT

 N AGUSR,AGDT,AGUSRL,AGDTL,AGUSRR,AGDTR

 ;

 S AGUSRL=$P($P(AGUID,"[",2),"__",1),AGDTL=$P($P($P(AGUID,"[",2),"__",2),"]",1)

 ;

 S AGUSRR=$$GET1^DIQ(9009063.5,AGREC,.03,"E"),AGDTR=$$FMTE^XLFDT($$GET1^DIQ(9009063.5,AGREC,.05,"I"))

 ;

 S AGUSR=$S(($E(AGUSRL,1,3)=$E(AGUSRR,1,3))&($E($P(AGUSRL,",",2),1)=$E($P(AGUSRR,",",2),1)):"1^PASSED",1:"0^FAILED ***")

 S AGDT=$S(AGDTL=$P(AGDTR,"@",1):"1^PASSED",1:"0^FAILED ***")

 ;

 W !,"USER: ",?16,AGUSRL,?30,"...",?35,$E(AGUSRR,1,23),?60,$P(AGUSR,U,2)

 W !,"DATE/TIME: ",?16,AGDTL,?30,"...",?35,$E(AGDTR,1,23),?60,$P(AGDT,U,2)

 ;

 Q $S(+AGUSR++AGDT=2:1,1:0)

 ;

P3(AGREC,AGPID) ;EP - CHECK PATIENT

 N AGDFN,AGNAM,AGDOB,AGSSN,AGNAML,AGDOBL,AGSSNL,AGNAMR,AGDOBR,AGSSNR

 ;

 S AGNAML=$P($P(AGPID,"[",2),"__",1),AGDOBL=$P($P(AGPID,"[",2),"__",2),AGSSNL="XXX-XX-"_$P($P($P(AGPID,"[",2),"__",3),"]",1)

 ;

 S AGDFN=$$GET1^DIQ(9009063.5,AGREC,.01,"I")

 S AGNAMR=$$GET1^DIQ(2,AGDFN,.01),AGDOBR=$$FMTE^XLFDT($$GET1^DIQ(2,AGDFN,.03,"I")),AGSSNR=$$GET1^DIQ(9000001,AGDFN,1107.3)

 ;

 S AGNAM=$S(($E(AGNAML,1,3)=$E(AGNAMR,1,3))&($E($P(AGNAML,",",2),1)=$E($P(AGNAMR,",",2),1)):"1^PASSED",1:"0^FAILED ***")

 S AGDOB=$S(AGDOBL=AGDOBR:"1^PASSED",1:"0^FAILED ***"),AGSSN=$S(AGSSNL=AGSSNR:"1^PASSED",1:"0^FAILED ***")

 ;

 W !,"PT NAME: ",?16,AGNAML,?30,"...",?35,$E(AGNAMR,1,23),?60,$P(AGNAM,U,2)

 W !,"PT DOB: ",?16,AGDOBL,?30,"...",?35,$E(AGDOBR,1,23),?60,$P(AGDOB,U,2)

 W !,"PT SSN: ",?16,AGSSNL,?30,"...",?35,$E(AGSSNR,1,23),?60,$P(AGSSN,U,2)

 ;

 Q $S(+AGNAM++AGDOB++AGSSN=3:1,1:0)

 ;

ENC(AGUSER,AGDT,AGDFN,AGREC) ;EP - CREATE UID

 N AGRES,AGCNT,AGRECE

 S AGRES=$$UIDE(AGUSER,AGDT)_$$ENC^AUPNPAT(AGDFN),AGRECE=""

 S AGREC=$TR(AGREC,"1234567890","7950318246")

 S:$L(AGREC>5) AGRECE=$E(AGREC,6,$L(AGREC)),AGREC=$E(AGREC,1,5)

 F AGCNT=$L(AGREC):-1:1 S AGRES=$E(AGRES,1,$S((AGCNT-1*4)<$L(AGRES)+1:(AGCNT-1*4),1:$L(AGRES)))_$E(AGREC,AGCNT,AGCNT)_$S((AGCNT-1*4+1)<$L(AGRES):$E(AGRES,(AGCNT-1*4+1),$L(AGRES)),1:"")

 S AGRES=AGRES_AGRECE

 Q AGRES

 ;

DEC(AGSTR) ;EP - DECODE UID

 N AGRES,AGCNT,AGUID,AGPID,AGREC

 S AGRES=AGSTR,AGREC="",AGRECE=""

 S:$L(AGRES>25) AGRECE=$E(AGRES,26,$L(AGRES)),AGRES=$E(AGRES,1,25)

 F AGCNT=0:1:$L(AGRES)-21 S AGREC=AGREC_$E(AGRES,(4*AGCNT+1),(4*AGCNT+1)),AGRES=$S((4*AGCNT)>0:$E(AGRES,1,(4*AGCNT)),1:"")_$E(AGRES,(4*AGCNT+2),$L(AGRES))

 S AGREC=AGREC_AGRECE

 S AGREC=$TR(AGREC,"7950318246","1234567890")

 Q AGREC_"^"_$$UIDD($E(AGRES,1,8))_"^"_$$DEC^AUPNPAT($E(AGRES,9,20))

 ;

UIDE(AGUSER,AGDT) ;EP - CREATE ENCRYPTED USER/DT CODE

 N AUPNX,AUPNV,X,X1,Y,I

 ; take 1st 3 chars of name, replace punctuation with numbers, pad out

 ;   to 3 chars

 S AUPNX=$E($P($P(^VA(200,AGUSER,0),U),","),1,3)

 S AUPNX=$TR(AUPNX," '-.,","01234")

 F I=1:1:(3-$L(AUPNX)) S AUPNX=AUPNX_"5"

 S AUPNV=AUPNX

 ;----------

 ; take 1st initial, 0 if null

 S AUPNX=$E($P($P(^VA(200,AGUSER,0),U),",",2)) S:AUPNX="" AUPNX=0

 ;----------

 ; concatenate in reverse order

 S AUPNV=$E(AUPNV,3)_$E(AUPNV,2)_$E(AUPNV)_AUPNX

 ;----------

 ; concatenate fileman date printed (converted to $H/hex format)

 S AUPNX=AGDT S:$L(AUPNX)'=7 AUPNX=3991231

 S AUPNX=$$FMTH^XLFDT(AUPNX,1)

 S X=AUPNX,X1=16 D CNV^XTBASE S Y=$E(Y,1,4)

 F I=1:1:(4-$L(Y)) S Y=Y_"-"

 S AUPNV=AUPNV_Y

 ;----------

 ; shuffle

 S AUPNV=$E(AUPNV,3,4)_$E(AUPNV,7,8)_$E(AUPNV,1,2)_$E(AUPNV,5,6)

 ;----------

 ; encrypt

 S AUPNV=$TR(AUPNV,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","UVWXJKLMYZABQRSTCDGHIEFNOP")

 S AUPNV=$TR(AUPNV,"1234567890","8967320415")

 ;----------

 Q AUPNV

UIDD(AGUID) ;EP - DECODE ENCRYPTED USER/DT CODE

 N AUPNX,AUPNV,AUPNY,X,X1,Y,I

 S AUPNV="["

 ;----------

 ; decrypt

 S AGUID=$TR(AGUID,"UVWXJKLMYZABQRSTCDGHIEFNOP","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 S AGUID=$TR(AGUID,"8967320415","1234567890")

 ;----------

 ; unshuffle

 S AGUID=$E(AGUID,5,6)_$E(AGUID,1,2)_$E(AGUID,7,8)_$E(AGUID,3,4)

 ;----------

 ; take 1st 3 chars of name, replace numbers with punctuation

 S AUPNX=""

 F I=3,2,1 S AUPNX=AUPNX_$E(AGUID,I)

 S AUPNX=$TR(AUPNX,"01234"," '-.,")

 S AUPNY=""

 F I=1:1:3 S:$E(AUPNX,I)'="5" AUPNY=AUPNY_$E(AUPNX,I)

 S AUPNX=AUPNY_","_$S($E(AGUID,4)'="0":$E(AGUID,4),1:"")

 S AUPNV=AUPNV_AUPNX

 ;----------

 ; fileman date printed (converted to external format)

 S AUPNX=""

 S X=$E(AGUID,5,8)

 F I=1:1:4 S:$E(X,I)'="-" AUPNX=AUPNX_$E(X,I)

 S X=AUPNX,X1=16 D DEC^XTBASE S AUPNX=Y

 S AUPNX=$$HTE^XLFDT(AUPNX,1)

 S AUPNV=AUPNV_"__"_AUPNX

 ;----------

 S AUPNV=AUPNV_"]"

 Q AUPNV

HDR ;HEADER TEXT

 ;;

 ;;Verify the authenticity of a printed IHS Eligibility Letter by entering the

 ;;unique identifier code given to you by the representative of the entity

 ;;requesting verification.

 ;;

 ;;*** NOTE: The codes printed on the IHS Eligibility Letters are unique to ***

 ;;*** a facility and can only be verified at the site it was printed from. ***

 ;;

 ;;END

AGACALV   ; IHS/OIT/NKD - VERIFY 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^AGACALV),";;",2)

               IF AGTEXT="END"

                   QUIT 

               Begin DoDot:1

 +3                WRITE !,AGTEXT

               End DoDot:1

 +4        DO MAIN

 +5        QUIT 

 +6       ;

MAIN      ;MAIN PROCESSING

 +1        NEW AGQUIT

 +2        SET AGQUIT=0

 +3        FOR 

               IF AGQUIT

                   QUIT 

               Begin DoDot:1

 +4                NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,Y,AGCODE,AGRES

 +5                SET DIR(0)="FOU^21"

 +6                SET DIR("A")="ENTER THE UNIQUE IDENTIFIER CODE (MINIMUM 21 DIGITS)"

 +7                DO ^DIR

 +8                IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)

                       SET AGQUIT=1

                       QUIT 

 +9                SET AGCODE=Y

 +10               SET AGRES=$$DEC(AGCODE)

 +11               WRITE !!,?16,"LETTER",?35,"RPMS",?60,"RESULTS"

 +12               WRITE !,?16,"------------",?35,"------------",?60,"------------"

 +13               IF '$$P1(+AGRES)

                       DO PROMPT

                       QUIT 

 +14               IF '$$P2(+AGRES,$PIECE(AGRES,U,2))

 +15               IF '$$P3(+AGRES,$PIECE(AGRES,U,3))

 +16               DO PROMPT

               End DoDot:1

 +17       QUIT 

 +18      ;

PROMPT    ;ENTER TO CONTINUE

 +1        KILL DIR

           SET DIR(0)="EO"

           SET DIR("A")="Press Enter to continue."

           DO ^DIR

           KILL DIR

           QUIT 

 +2       ;

P1(AGREC) ;EP - CHECK RECORD NUMBER

 +1        NEW AGRES

 +2       ;

 +3        SET AGRES=$SELECT($DATA(^AGACAL(AGREC,0)):AGREC_U_"PASSED",1:"0^FAILED ***")

 +4       ;

 +5        WRITE !,"RECORD NUMBER: ",?16,AGREC,?30,"...",?35,+AGRES,?60,$PIECE(AGRES,U,2)

 +6       ;

 +7        QUIT $SELECT(+AGRES:1,1:0)

 +8       ;

P2(AGREC,AGUID) ;EP - CHECK USER/DT

 +1        NEW AGUSR,AGDT,AGUSRL,AGDTL,AGUSRR,AGDTR

 +2       ;

 +3        SET AGUSRL=$PIECE($PIECE(AGUID,"[",2),"__",1)

           SET AGDTL=$PIECE($PIECE($PIECE(AGUID,"[",2),"__",2),"]",1)

 +4       ;

 +5        SET AGUSRR=$$GET1^DIQ(9009063.5,AGREC,.03,"E")

           SET AGDTR=$$FMTE^XLFDT($$GET1^DIQ(9009063.5,AGREC,.05,"I"))

 +6       ;

 +7        SET AGUSR=$SELECT(($EXTRACT(AGUSRL,1,3)=$EXTRACT(AGUSRR,1,3))&($EXTRACT($PIECE(AGUSRL,",",2),1)=$EXTRACT($PIECE(AGUSRR,",",2),1)):"1^PASSED",1:"0^FAILED ***")

 +8        SET AGDT=$SELECT(AGDTL=$PIECE(AGDTR,"@",1):"1^PASSED",1:"0^FAILED ***")

 +9       ;

 +10       WRITE !,"USER: ",?16,AGUSRL,?30,"...",?35,$EXTRACT(AGUSRR,1,23),?60,$PIECE(AGUSR,U,2)

 +11       WRITE !,"DATE/TIME: ",?16,AGDTL,?30,"...",?35,$EXTRACT(AGDTR,1,23),?60,$PIECE(AGDT,U,2)

 +12      ;

 +13       QUIT $SELECT(+AGUSR++AGDT=2:1,1:0)

 +14      ;

P3(AGREC,AGPID) ;EP - CHECK PATIENT

 +1        NEW AGDFN,AGNAM,AGDOB,AGSSN,AGNAML,AGDOBL,AGSSNL,AGNAMR,AGDOBR,AGSSNR

 +2       ;

 +3        SET AGNAML=$PIECE($PIECE(AGPID,"[",2),"__",1)

           SET AGDOBL=$PIECE($PIECE(AGPID,"[",2),"__",2)

           SET AGSSNL="XXX-XX-"_$PIECE($PIECE($PIECE(AGPID,"[",2),"__",3),"]",1)

 +4       ;

 +5        SET AGDFN=$$GET1^DIQ(9009063.5,AGREC,.01,"I")

 +6        SET AGNAMR=$$GET1^DIQ(2,AGDFN,.01)

           SET AGDOBR=$$FMTE^XLFDT($$GET1^DIQ(2,AGDFN,.03,"I"))

           SET AGSSNR=$$GET1^DIQ(9000001,AGDFN,1107.3)

 +7       ;

 +8        SET AGNAM=$SELECT(($EXTRACT(AGNAML,1,3)=$EXTRACT(AGNAMR,1,3))&($EXTRACT($PIECE(AGNAML,",",2),1)=$EXTRACT($PIECE(AGNAMR,",",2),1)):"1^PASSED",1:"0^FAILED ***")

 +9        SET AGDOB=$SELECT(AGDOBL=AGDOBR:"1^PASSED",1:"0^FAILED ***")

           SET AGSSN=$SELECT(AGSSNL=AGSSNR:"1^PASSED",1:"0^FAILED ***")

 +10      ;

 +11       WRITE !,"PT NAME: ",?16,AGNAML,?30,"...",?35,$EXTRACT(AGNAMR,1,23),?60,$PIECE(AGNAM,U,2)

 +12       WRITE !,"PT DOB: ",?16,AGDOBL,?30,"...",?35,$EXTRACT(AGDOBR,1,23),?60,$PIECE(AGDOB,U,2)

 +13       WRITE !,"PT SSN: ",?16,AGSSNL,?30,"...",?35,$EXTRACT(AGSSNR,1,23),?60,$PIECE(AGSSN,U,2)

 +14      ;

 +15       QUIT $SELECT(+AGNAM++AGDOB++AGSSN=3:1,1:0)

 +16      ;

ENC(AGUSER,AGDT,AGDFN,AGREC) ;EP - CREATE UID

 +1        NEW AGRES,AGCNT,AGRECE

 +2        SET AGRES=$$UIDE(AGUSER,AGDT)_$$ENC^AUPNPAT(AGDFN)

           SET AGRECE=""

 +3        SET AGREC=$TRANSLATE(AGREC,"1234567890","7950318246")

 +4        IF $LENGTH(AGREC>5)

               SET AGRECE=$EXTRACT(AGREC,6,$LENGTH(AGREC))

               SET AGREC=$EXTRACT(AGREC,1,5)

 +5        FOR AGCNT=$LENGTH(AGREC):-1:1

               SET AGRES=$EXTRACT(AGRES,1,$SELECT((AGCNT-1*4)<$LENGTH(AGRES)+1:(AGCNT-1*4),1:$LENGTH(AGRES)))_$EXTRACT(AGREC,AGCNT,AGCNT)_$SELECT((AGCNT-1*4+1)<$LENGTH(AGRES):$EXTRACT(AGRES,(AGCNT-1*4+1),$LENGTH(AGRES)),1:"")

 +6        SET AGRES=AGRES_AGRECE

 +7        QUIT AGRES

 +8       ;

DEC(AGSTR) ;EP - DECODE UID

 +1        NEW AGRES,AGCNT,AGUID,AGPID,AGREC

 +2        SET AGRES=AGSTR

           SET AGREC=""

           SET AGRECE=""

 +3        IF $LENGTH(AGRES>25)

               SET AGRECE=$EXTRACT(AGRES,26,$LENGTH(AGRES))

               SET AGRES=$EXTRACT(AGRES,1,25)

 +4        FOR AGCNT=0:1:$LENGTH(AGRES)-21

               SET AGREC=AGREC_$EXTRACT(AGRES,(4*AGCNT+1),(4*AGCNT+1))

               SET AGRES=$SELECT((4*AGCNT)>0:$EXTRACT(AGRES,1,(4*AGCNT)),1:"")_$EXTRACT(AGRES,(4*AGCNT+2),$LENGTH(AGRES))

 +5        SET AGREC=AGREC_AGRECE

 +6        SET AGREC=$TRANSLATE(AGREC,"7950318246","1234567890")

 +7        QUIT AGREC_"^"_$$UIDD($EXTRACT(AGRES,1,8))_"^"_$$DEC^AUPNPAT($EXTRACT(AGRES,9,20))

 +8       ;

UIDE(AGUSER,AGDT) ;EP - CREATE ENCRYPTED USER/DT CODE

 +1        NEW AUPNX,AUPNV,X,X1,Y,I

 +2       ; take 1st 3 chars of name, replace punctuation with numbers, pad out

 +3       ;   to 3 chars

 +4        SET AUPNX=$EXTRACT($PIECE($PIECE(^VA(200,AGUSER,0),U),","),1,3)

 +5        SET AUPNX=$TRANSLATE(AUPNX," '-.,","01234")

 +6        FOR I=1:1:(3-$LENGTH(AUPNX))

               SET AUPNX=AUPNX_"5"

 +7        SET AUPNV=AUPNX

 +8       ;----------

 +9       ; take 1st initial, 0 if null

 +10       SET AUPNX=$EXTRACT($PIECE($PIECE(^VA(200,AGUSER,0),U),",",2))

           IF AUPNX=""

               SET AUPNX=0

 +11      ;----------

 +12      ; concatenate in reverse order

 +13       SET AUPNV=$EXTRACT(AUPNV,3)_$EXTRACT(AUPNV,2)_$EXTRACT(AUPNV)_AUPNX

 +14      ;----------

 +15      ; concatenate fileman date printed (converted to $H/hex format)

 +16       SET AUPNX=AGDT

           IF $LENGTH(AUPNX)'=7

               SET AUPNX=3991231

 +17       SET AUPNX=$$FMTH^XLFDT(AUPNX,1)

 +18       SET X=AUPNX

           SET X1=16

           DO CNV^XTBASE

           SET Y=$EXTRACT(Y,1,4)

 +19       FOR I=1:1:(4-$LENGTH(Y))

               SET Y=Y_"-"

 +20       SET AUPNV=AUPNV_Y

 +21      ;----------

 +22      ; shuffle

 +23       SET AUPNV=$EXTRACT(AUPNV,3,4)_$EXTRACT(AUPNV,7,8)_$EXTRACT(AUPNV,1,2)_$EXTRACT(AUPNV,5,6)

 +24      ;----------

 +25      ; encrypt

 +26       SET AUPNV=$TRANSLATE(AUPNV,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","UVWXJKLMYZABQRSTCDGHIEFNOP")

 +27       SET AUPNV=$TRANSLATE(AUPNV,"1234567890","8967320415")

 +28      ;----------

 +29       QUIT AUPNV

UIDD(AGUID) ;EP - DECODE ENCRYPTED USER/DT CODE

 +1        NEW AUPNX,AUPNV,AUPNY,X,X1,Y,I

 +2        SET AUPNV="["

 +3       ;----------

 +4       ; decrypt

 +5        SET AGUID=$TRANSLATE(AGUID,"UVWXJKLMYZABQRSTCDGHIEFNOP","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +6        SET AGUID=$TRANSLATE(AGUID,"8967320415","1234567890")

 +7       ;----------

 +8       ; unshuffle

 +9        SET AGUID=$EXTRACT(AGUID,5,6)_$EXTRACT(AGUID,1,2)_$EXTRACT(AGUID,7,8)_$EXTRACT(AGUID,3,4)

 +10      ;----------

 +11      ; take 1st 3 chars of name, replace numbers with punctuation

 +12       SET AUPNX=""

 +13       FOR I=3,2,1

               SET AUPNX=AUPNX_$EXTRACT(AGUID,I)

 +14       SET AUPNX=$TRANSLATE(AUPNX,"01234"," '-.,")

 +15       SET AUPNY=""

 +16       FOR I=1:1:3

               IF $EXTRACT(AUPNX,I)'="5"

                   SET AUPNY=AUPNY_$EXTRACT(AUPNX,I)

 +17       SET AUPNX=AUPNY_","_$SELECT($EXTRACT(AGUID,4)'="0":$EXTRACT(AGUID,4),1:"")

 +18       SET AUPNV=AUPNV_AUPNX

 +19      ;----------

 +20      ; fileman date printed (converted to external format)

 +21       SET AUPNX=""

 +22       SET X=$EXTRACT(AGUID,5,8)

 +23       FOR I=1:1:4

               IF $EXTRACT(X,I)'="-"

                   SET AUPNX=AUPNX_$EXTRACT(X,I)

 +24       SET X=AUPNX

           SET X1=16

           DO DEC^XTBASE

           SET AUPNX=Y

 +25       SET AUPNX=$$HTE^XLFDT(AUPNX,1)

 +26       SET AUPNV=AUPNV_"__"_AUPNX

 +27      ;----------

 +28       SET AUPNV=AUPNV_"]"

 +29       QUIT AUPNV

HDR       ;HEADER TEXT

 +1       ;;

 +2       ;;Verify the authenticity of a printed IHS Eligibility Letter by entering the

 +3       ;;unique identifier code given to you by the representative of the entity

 +4       ;;requesting verification.

 +5       ;;

 +6       ;;*** NOTE: The codes printed on the IHS Eligibility Letters are unique to ***

 +7       ;;*** a facility and can only be verified at the site it was printed from. ***

 +8       ;;

 +9       ;;END