APCLRPLP.m

APCLRPLP ; IHS/CMI/LAB - print patient list ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;IHS/CMI/LAB - y2k

 ;

 ;

 S APCLPG=0

 K APCLQUIT

 I '$D(^XTMP("APCLRPL",APCLJOB,APCLBTH)) D HEAD W !!,"NO PATIENTS TO REPORT",!! G DONE

 D PROC

 G:$D(APCLQUIT) DONE

 W !!,"TOTAL NUMBER OF PATIENTS: ",APCLPTCT,!

DONE ;

 D DONE^APCLOSUT

 K ^XTMP("APCLRPL",APCLJOB,APCLBT)

 Q

PROC ;

 D HEAD

 Q:$D(APCLQUIT)

 S (APCLSRTV,APCLFRST)="" K APCLQUIT

 F  S APCLSRTV=$O(^XTMP("APCLRPL",APCLJOB,APCLBTH,"DATA HITS",APCLSRTV)) Q:APCLSRTV=""!($D(APCLQUIT))  D V

 G:$D(APCLQUIT) DONE

 Q

V ;

 S DFN=0 F  S DFN=$O(^XTMP("APCLRPL",APCLJOB,APCLBTH,"DATA HITS",APCLSRTV,DFN)) Q:DFN'=+DFN!($D(APCLQUIT))  D

 .S X=$$PREC^APCLVDR(DFN,"R-DMG-510")

 .Q:X=""

 .Q:X=-1

 .I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)

 .W !,X

 .Q

 Q

HEAD I 'APCLPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q

HEAD1 ;

 W:$D(IOF) @IOF S APCLPG=APCLPG+1

 W !?45,"*****   CONFIDENTIAL PATIENT DATA   *****"

 W !!?55,"INDIAN HEALTH SERVICE",?100,"PAGE:",?111,APCLPG

 ;begin Y2K

 W !?52,"PATIENT REGISTRATION SYSTEM",?100,"DATE:",?111,$$FMTE^XLFDT(DT,1) ;CMI/TUCSON/LAB - 4 digit year ;Y2000

 ;end Y2K

 W !,"AREA: ",$P(^AUTTAREA($P(^AUTTLOC(APCLLOC,0),U,4),0),U),?52,"SU: ",$P(^AUTTSU($P(^AUTTLOC(APCLLOC,0),U,5),0),U),?100,"FACILITY:",?111,$E($P(^DIC(4,APCLLOC,0),U),1,21)

 W !!?46,"BIRTH",?72,"BLOOD",?80,"--- ELIGIBILITY ---"

 W !,?1,"HRN NO",?20,"NAME",?46,"DATE",?56,"SEX",?62,"TRB",?67,"BEN",?72,"QUNTM",?80,"MCR",?84,"MCD",?88,"PVT",?92,"VET",?96,"CHS",?100,"RESIDENCE",?117,"SOC SEC NO"

 W !,$TR($J("",132)," ","-")

 Q

APCLRPLP  ; IHS/CMI/LAB - print patient list ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;IHS/CMI/LAB - y2k

 +3       ;

 +4       ;

 +5        SET APCLPG=0

 +6        KILL APCLQUIT

 +7        IF '$DATA(^XTMP("APCLRPL",APCLJOB,APCLBTH))

               DO HEAD

               WRITE !!,"NO PATIENTS TO REPORT",!!

               GOTO DONE

 +8        DO PROC

 +9        IF $DATA(APCLQUIT)

               GOTO DONE

 +10       WRITE !!,"TOTAL NUMBER OF PATIENTS: ",APCLPTCT,!

DONE      ;

 +1        DO DONE^APCLOSUT

 +2        KILL ^XTMP("APCLRPL",APCLJOB,APCLBT)

 +3        QUIT 

PROC      ;

 +1        DO HEAD

 +2        IF $DATA(APCLQUIT)

               QUIT 

 +3        SET (APCLSRTV,APCLFRST)=""

           KILL APCLQUIT

 +4        FOR 

               SET APCLSRTV=$ORDER(^XTMP("APCLRPL",APCLJOB,APCLBTH,"DATA HITS",APCLSRTV))

               IF APCLSRTV=""!($DATA(APCLQUIT))

                   QUIT 

               DO V

 +5        IF $DATA(APCLQUIT)

               GOTO DONE

 +6        QUIT 

V         ;

 +1        SET DFN=0

           FOR 

               SET DFN=$ORDER(^XTMP("APCLRPL",APCLJOB,APCLBTH,"DATA HITS",APCLSRTV,DFN))

               IF DFN'=+DFN!($DATA(APCLQUIT))

                   QUIT 

               Begin DoDot:1

 +2                SET X=$$PREC^APCLVDR(DFN,"R-DMG-510")

 +3                IF X=""

                       QUIT 

 +4                IF X=-1

                       QUIT 

 +5                IF $Y>(IOSL-5)

                       DO HEAD

                       IF $DATA(APCLQUIT)

                           QUIT 

 +6                WRITE !,X

 +7                QUIT 

               End DoDot:1

 +8        QUIT 

HEAD       IF 'APCLPG

               GOTO HEAD1

 +1        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET APCLQUIT=""

                       QUIT 

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET APCLPG=APCLPG+1

 +2        WRITE !?45,"*****   CONFIDENTIAL PATIENT DATA   *****"

 +3        WRITE !!?55,"INDIAN HEALTH SERVICE",?100,"PAGE:",?111,APCLPG

 +4       ;begin Y2K

 +5       ;CMI/TUCSON/LAB - 4 digit year ;Y2000

           WRITE !?52,"PATIENT REGISTRATION SYSTEM",?100,"DATE:",?111,$$FMTE^XLFDT(DT,1)

 +6       ;end Y2K

 +7        WRITE !,"AREA: ",$PIECE(^AUTTAREA($PIECE(^AUTTLOC(APCLLOC,0),U,4),0),U),?52,"SU: ",$PIECE(^AUTTSU($PIECE(^AUTTLOC(APCLLOC,0),U,5),0),U),?100,"FACILITY:",?111,$EXTRACT($PIECE(^DIC(4,APCLLOC,0),U),1,21)

 +8        WRITE !!?46,"BIRTH",?72,"BLOOD",?80,"--- ELIGIBILITY ---"

 +9        WRITE !,?1,"HRN NO",?20,"NAME",?46,"DATE",?56,"SEX",?62,"TRB",?67,"BEN",?72,"QUNTM",?80,"MCR",?84,"MCD",?88,"PVT",?92,"VET",?96,"CHS",?100,"RESIDENCE",?117,"SOC SEC NO"

 +10       WRITE !,$TRANSLATE($JUSTIFY("",132)," ","-")

 +11       QUIT