APCLAP6P ; IHS/CMI/LAB - PRINT CLINIC VISITS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
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("APCLAP6",APCLJOB,APCLBTH)) D HEAD W !,"No visits to report." G END
;
SET ;
D HEAD
S APCLAP=0
F S APCLAP=$O(^XTMP("APCLAP6",APCLJOB,APCLBTH,APCLAP)) Q:APCLAP=""!($D(APCLQUIT)) D SET2
END ;
D DONE^APCLOSUT
K ^XTMP("APCLAP6",APCLJOB,APCLBTH)
Q
SET2 ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,$E($S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLAP,0),U),1:$P(^DIC(16,APCLAP,0),U)),1,15)
S J=18,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("APCLAP6",APCLJOB,APCLBTH,APCLAP,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 !?19,"PRIMARY CARE PROVIDER VISITS - ",$S(APCLDY="Y":"YEARLY",1:"DAILY")," REPORT"
W !?18,"VISITS DATES: ",APCLBDD," TO ",APCLEDD
I $D(APCLCLNT) D
.S APCLL=$S(APCLLOC=0:"ALL",1:"SELECTED")
.S APCLLENG=21+$L(APCLL)
.W !?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLL
W !!?2,"PROVIDER"
I $D(APCLCLNT) S X=0,J=18 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=18 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>80:132,1:80) W $TR($J("",X)," ","-")
W !
Q
;
APCLAP6P ; IHS/CMI/LAB - PRINT CLINIC VISITS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
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("APCLAP6",APCLJOB,APCLBTH))
DO HEAD
WRITE !,"No visits to report."
GOTO END
+5 ;
SET ;
+1 DO HEAD
+2 SET APCLAP=0
+3 FOR
SET APCLAP=$ORDER(^XTMP("APCLAP6",APCLJOB,APCLBTH,APCLAP))
IF APCLAP=""!($DATA(APCLQUIT))
QUIT
DO SET2
END ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLAP6",APCLJOB,APCLBTH)
+3 QUIT
SET2 ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !,$EXTRACT($SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLAP,0),U),1:$PIECE(^DIC(16,APCLAP,0),U)),1,15)
+3 SET J=18
SET APCLX=0
+4 IF $DATA(APCLCLNT)
FOR
SET APCLX=$ORDER(APCLCLNT(APCLX))
IF APCLX'=+APCLX
QUIT
DO PRINT
+5 IF $DATA(APCLLOCT)
FOR
SET APCLX=$ORDER(APCLLOCT(APCLX))
IF APCLX'=+APCLX
QUIT
DO PRINT
+6 QUIT
+7 ;
PRINT ;
+1 SET Y=$SELECT($DATA(^XTMP("APCLAP6",APCLJOB,APCLBTH,APCLAP,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 !?19,"PRIMARY CARE PROVIDER VISITS - ",$SELECT(APCLDY="Y":"YEARLY",1:"DAILY")," REPORT"
+6 WRITE !?18,"VISITS DATES: ",APCLBDD," TO ",APCLEDD
+7 IF $DATA(APCLCLNT)
Begin DoDot:1
+8 SET APCLL=$SELECT(APCLLOC=0:"ALL",1:"SELECTED")
+9 SET APCLLENG=21+$LENGTH(APCLL)
+10 WRITE !?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLL
End DoDot:1
+11 WRITE !!?2,"PROVIDER"
+12 IF $DATA(APCLCLNT)
SET X=0
SET J=18
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=18
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>80:132,1:80)
WRITE $TRANSLATE($JUSTIFY("",X)," ","-")
+15 WRITE !
+16 QUIT
+17 ;
