- 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
