- APCLAP5P ; IHS/CMI/LAB - PRINT CLINIC VISITS ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;IHS/CMI/LAB - Y2K
- ;
- INIT ;
- S APCLDT=$$FMTE^XLFDT(DT)
- S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
- S APCLPG=0
- I '$D(^XTMP("APCLAP5",APCLJOB,APCLBTH)) D HEAD W !,"No visits to report." G END
- ;
- SET ;
- D HEAD
- S APCLVD=0
- F S APCLVD=$O(^XTMP("APCLAP5",APCLJOB,APCLBTH,APCLVD)) Q:APCLVD=""!($D(APCLQUIT)) D SET2
- END ;
- D DONE^APCLOSUT
- K ^XTMP("APCLAP5",APCLJOB,APCLBTH)
- Q
- SET2 ;
- I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
- ;begin Y2K
- ;W !,$E(APCLVD,4,5),"/",$E(APCLVD,6,7),"/",$E(APCLVD,2,3) ;Y2000
- W !,$E(APCLVD,4,5),"/",$E(APCLVD,6,7),"/",(1700+($E(APCLVD,1,3))) ;Y2000
- ;end Y2K
- S J=12,APCLX=0
- I $D(APCLCLNT) F S APCLX=$O(APCLCLNT(APCLX)) Q:APCLX'=+APCLX D PRINT
- I $D(APCLLOCT) F S APCLX=$O(APCLLOCT(APCLX)) Q:APCLX'=+APCLX D PRINT
- Q
- ;
- PRINT ;
- S Y=$S($D(^XTMP("APCLAP5",APCLJOB,APCLBTH,APCLVD,APCLX)):^(APCLX),1:0)
- W ?J,$J(Y,7) S J=J+10
- 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 !
- S X=$P(^DIC(4,DUZ(2),0),U)
- W !!,$P(^VA(200,DUZ,0),"^",2),?(80-$L(X)/2),X,?70,"Page ",APCLPG
- W !?13,"PRIMARY CARE PROVIDER VISITS - PRIMARY PROVIDER ONLY"
- W !?18,"VISITS DATES: ",APCLBDD," TO ",APCLEDD
- I $D(APCLCLNT) D
- .S APCLL=$S(APCLLOC="":"ALL",1:"SELECTED")
- .S APCLLENG=21+$L(APCLL)
- .W !?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLL
- W !!?2,"DATE"
- I $D(APCLCLNT) S X=0,J=12 F S X=$O(APCLCLNT(X)) Q:X'=+X W ?J,$E($P(^DIC(40.7,X,0),U),1,8) S J=J+10
- I $D(APCLLOCT) S X=0,J=12 F S X=$O(APCLLOCT(X)) Q:X'=+X W ?J,$E($P(^DIC(4,X,0),U),1,8) S J=J+10
- W ! S X=$S(J>75:132,1:80) W $TR($J("",X)," ","-")
- W !
- Q
- ;
- APCLAP5P ; IHS/CMI/LAB - PRINT CLINIC VISITS ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;IHS/CMI/LAB - Y2K
- +3 ;
- INIT ;
- +1 SET APCLDT=$$FMTE^XLFDT(DT)
- +2 SET Y=APCLBD
- DO DD^%DT
- SET APCLBDD=Y
- SET Y=APCLED
- DO DD^%DT
- SET APCLEDD=Y
- +3 SET APCLPG=0
- +4 IF '$DATA(^XTMP("APCLAP5",APCLJOB,APCLBTH))
- DO HEAD
- WRITE !,"No visits to report."
- GOTO END
- +5 ;
- SET ;
- +1 DO HEAD
- +2 SET APCLVD=0
- +3 FOR
- SET APCLVD=$ORDER(^XTMP("APCLAP5",APCLJOB,APCLBTH,APCLVD))
- IF APCLVD=""!($DATA(APCLQUIT))
- QUIT
- DO SET2
- END ;
- +1 DO DONE^APCLOSUT
- +2 KILL ^XTMP("APCLAP5",APCLJOB,APCLBTH)
- +3 QUIT
- SET2 ;
- +1 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +2 ;begin Y2K
- +3 ;W !,$E(APCLVD,4,5),"/",$E(APCLVD,6,7),"/",$E(APCLVD,2,3) ;Y2000
- +4 ;Y2000
- WRITE !,$EXTRACT(APCLVD,4,5),"/",$EXTRACT(APCLVD,6,7),"/",(1700+($EXTRACT(APCLVD,1,3)))
- +5 ;end Y2K
- +6 SET J=12
- SET APCLX=0
- +7 IF $DATA(APCLCLNT)
- FOR
- SET APCLX=$ORDER(APCLCLNT(APCLX))
- IF APCLX'=+APCLX
- QUIT
- DO PRINT
- +8 IF $DATA(APCLLOCT)
- FOR
- SET APCLX=$ORDER(APCLLOCT(APCLX))
- IF APCLX'=+APCLX
- QUIT
- DO PRINT
- +9 QUIT
- +10 ;
- PRINT ;
- +1 SET Y=$SELECT($DATA(^XTMP("APCLAP5",APCLJOB,APCLBTH,APCLVD,APCLX)):^(APCLX),1:0)
- +2 WRITE ?J,$JUSTIFY(Y,7)
- SET J=J+10
- +3 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 !
- +3 SET X=$PIECE(^DIC(4,DUZ(2),0),U)
- +4 WRITE !!,$PIECE(^VA(200,DUZ,0),"^",2),?(80-$LENGTH(X)/2),X,?70,"Page ",APCLPG
- +5 WRITE !?13,"PRIMARY CARE PROVIDER VISITS - PRIMARY PROVIDER ONLY"
- +6 WRITE !?18,"VISITS DATES: ",APCLBDD," TO ",APCLEDD
- +7 IF $DATA(APCLCLNT)
- Begin DoDot:1
- +8 SET APCLL=$SELECT(APCLLOC="":"ALL",1:"SELECTED")
- +9 SET APCLLENG=21+$LENGTH(APCLL)
- +10 WRITE !?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLL
- End DoDot:1
- +11 WRITE !!?2,"DATE"
- +12 IF $DATA(APCLCLNT)
- SET X=0
- SET J=12
- FOR
- SET X=$ORDER(APCLCLNT(X))
- IF X'=+X
- QUIT
- WRITE ?J,$EXTRACT($PIECE(^DIC(40.7,X,0),U),1,8)
- SET J=J+10
- +13 IF $DATA(APCLLOCT)
- SET X=0
- SET J=12
- FOR
- SET X=$ORDER(APCLLOCT(X))
- IF X'=+X
- QUIT
- WRITE ?J,$EXTRACT($PIECE(^DIC(4,X,0),U),1,8)
- SET J=J+10
- +14 WRITE !
- SET X=$SELECT(J>75:132,1:80)
- WRITE $TRANSLATE($JUSTIFY("",X)," ","-")
- +15 WRITE !
- +16 QUIT
- +17 ;
