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 ;
