- 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 ;
