AGELUP6.m

AGELUP6 ;IHS/ASDS/EFG - UPDATE ELIGIBILITY FROM FILE  

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

HEAD ;EP - page header

 S $P(AGEQ,"=",80)=""

 S $P(AGDSH,"-",80)=""

 U IO(0)

 W $$S^AGVDF("IOF")

 W !,"HOST FILE RECORD #: ",AGRCNT

 W !,"PATIENT: "

 W $P(^DPT(AG("DFN"),0),"^",1)

 W ?35,"SSN: "

 W $E(AG("FSSN"),1,3)_"-"_$E(AG("FSSN"),4,5)_"-"_$E(AG("FSSN"),6,9)

 W !,AGEQ

 W !,?3,"RAILROAD ELIGIBLE FILE"

 W ?48,"HCFA FILE"

 W !,AGDSH

 Q

PEND ;EP - end of page

 U IO(0) F  W ! Q:($Y+3)>IOSL

 K DIR S DIR(0)="SBM^F:FILE;S:SKIP;Q:QUIT"

 S DIR("A")="ACTION: (F)ILE, (S)KIP, (Q)UIT"

 S DIR("B")="QUIT"

 D ^DIR K DIR

 S AGACT=Y

 Q

AGELUP6   ;IHS/ASDS/EFG - UPDATE ELIGIBILITY FROM FILE  

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

HEAD      ;EP - page header

 +1        SET $PIECE(AGEQ,"=",80)=""

 +2        SET $PIECE(AGDSH,"-",80)=""

 +3        USE IO(0)

 +4        WRITE $$S^AGVDF("IOF")

 +5        WRITE !,"HOST FILE RECORD #: ",AGRCNT

 +6        WRITE !,"PATIENT: "

 +7        WRITE $PIECE(^DPT(AG("DFN"),0),"^",1)

 +8        WRITE ?35,"SSN: "

 +9        WRITE $EXTRACT(AG("FSSN"),1,3)_"-"_$EXTRACT(AG("FSSN"),4,5)_"-"_$EXTRACT(AG("FSSN"),6,9)

 +10       WRITE !,AGEQ

 +11       WRITE !,?3,"RAILROAD ELIGIBLE FILE"

 +12       WRITE ?48,"HCFA FILE"

 +13       WRITE !,AGDSH

 +14       QUIT 

PEND      ;EP - end of page

 +1        USE IO(0)

           FOR 

               WRITE !

               IF ($Y+3)>IOSL

                   QUIT 

 +2        KILL DIR

           SET DIR(0)="SBM^F:FILE;S:SKIP;Q:QUIT"

 +3        SET DIR("A")="ACTION: (F)ILE, (S)KIP, (Q)UIT"

 +4        SET DIR("B")="QUIT"

 +5        DO ^DIR

           KILL DIR

 +6        SET AGACT=Y

 +7        QUIT