BKMVSSR3 ;PRXM/HC/CLT - STATE SURV. REPORT PRINT ; 31 Mar 2005 3:51 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
;
EN ;EP - MAIN ROUTINE ENTRY POINT
S BKMHDR=$P(^BKM(90456,1,0),U,1),BKMHDR1=$P(^BKM(90456,1,0),U,2)
S BKMPAD=80-$L(BKMHDR)\2
F BKM=1:1:BKMPAD-2 S BKMHDR="*"_BKMHDR
F BKM=1:1:BKMPAD-2 S BKMHDR=BKMHDR_"*"
S BKMHDR1="********** "_BKMHDR1_" **********"
;S %DT="",X="T" D ^%DT S BKMNDT=Y S BKMVNDT=$$FMTE^XLFDT(BKMNDT\1,"5Z")
S BKMVNDT=$$FMTE^XLFDT($$DT^XLFDT(),"5Z")
S PAGE=0,BKMX=0
D HDR Q:BKMX
D HDR1,HDR2,SUBHEAD
D SECTIONI
Q
SUBHEAD ;PAGE 1 SUBHEADER
W !?1
S DIWF="W",DIWR=77,DIWL=6
S BKMLINE=0 F S BKMLINE=$O(^BKM(90456,1,1,BKMLINE)) Q:'BKMLINE S X=^BKM(90456,1,1,BKMLINE,0) D ^DIWP D:$Y>(IOSL-2) HDR^BKMVSSR3 Q:BKMX
D ^DIWW
Q
HDR ;EP - REPORT MAIN HEADER
I PAGE'=0 S BKMX=$$PAUSE^BKMIXX3 Q:BKMX W @IOF
I PAGE=0 S:IOST["P-" $X=0 W:IOST["C-" @IOF
S PAGE=PAGE+1
W ?1,BKMVNDT,?70,"Page ",PAGE
Q
HDR1 ;EP - PAGE 1 HEADER
W !,?80-$L(BKMHDR)\2,BKMHDR,!?1
Q
HDR2 ;PAGE 1 ADDITIONAL LINE
W ?80-$L(BKMHDR1)\2,BKMHDR1,!?1
Q
SECTIONI ;SECTION I PRINT
S BKMLINE=$P(^BKM(90456,1,2,1,0),U,2),BKMLINE1=$P(^BKM(90456,1,2,1,0),U,3),BKMSEC=$P(^BKM(90456,1,2,1,0),U,1)
Q:$P(^BKM(90456,1,2,1,0),U,4)'="Y"
W !!?1,"SECTION I: ",BKMLINE,!?11,BKMLINE1,!?1
F BKM=1:1:9 D Q:BKMX
.I $Y>(IOSL-4) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
.S BKMLINE=$P(^BKM(90456,1,2,1,1,BKM,0),U,1),BKMLINE1=$P($G(^BKM(90456,1,2,1,1,BKM,1,1,0)),U,1)
.D LPRINT
Q
LPRINT ;PRINT A LINE WITH DATA
W !?1,BKMLINE W:BKMLINE1]"" " ",BKMLINE1 W ": "
I BKM=1 W $S($G(DFN)]"":$$GET1^DIQ(2,DFN,.01,"E"),1:"")
I BKM=2 W $S($D(BKMVPHN):BKMVPHN,1:"")
I BKM=3 W $S($D(BKMVADDL):BKMVADDL,1:"")
I BKM=4 W $S($D(BKMVHRN):BKMVHRN,1:"")
I BKM=5 W $S($D(BKMPROV):BKMPROV,1:"")
I BKM=6 W $S($D(BKMVPPH):BKMVPPH,1:"")
I BKM=7 W $S($D(BKMVLOC):BKMVLOC,1:"")
I BKM=8 ; No data to print for this field currently
I BKM=9 ; No data to print for this field currently
Q
BKMVSSR3 ;PRXM/HC/CLT - STATE SURV. REPORT PRINT ; 31 Mar 2005 3:51 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ;
EN ;EP - MAIN ROUTINE ENTRY POINT
+1 SET BKMHDR=$PIECE(^BKM(90456,1,0),U,1)
SET BKMHDR1=$PIECE(^BKM(90456,1,0),U,2)
+2 SET BKMPAD=80-$LENGTH(BKMHDR)\2
+3 FOR BKM=1:1:BKMPAD-2
SET BKMHDR="*"_BKMHDR
+4 FOR BKM=1:1:BKMPAD-2
SET BKMHDR=BKMHDR_"*"
+5 SET BKMHDR1="********** "_BKMHDR1_" **********"
+6 ;S %DT="",X="T" D ^%DT S BKMNDT=Y S BKMVNDT=$$FMTE^XLFDT(BKMNDT\1,"5Z")
+7 SET BKMVNDT=$$FMTE^XLFDT($$DT^XLFDT(),"5Z")
+8 SET PAGE=0
SET BKMX=0
+9 DO HDR
IF BKMX
QUIT
+10 DO HDR1
DO HDR2
DO SUBHEAD
+11 DO SECTIONI
+12 QUIT
SUBHEAD ;PAGE 1 SUBHEADER
+1 WRITE !?1
+2 SET DIWF="W"
SET DIWR=77
SET DIWL=6
+3 SET BKMLINE=0
FOR
SET BKMLINE=$ORDER(^BKM(90456,1,1,BKMLINE))
IF 'BKMLINE
QUIT
SET X=^BKM(90456,1,1,BKMLINE,0)
DO ^DIWP
IF $Y>(IOSL-2)
DO HDR^BKMVSSR3
IF BKMX
QUIT
+4 DO ^DIWW
+5 QUIT
HDR ;EP - REPORT MAIN HEADER
+1 IF PAGE'=0
SET BKMX=$$PAUSE^BKMIXX3
IF BKMX
QUIT
WRITE @IOF
+2 IF PAGE=0
IF IOST["P-"
SET $X=0
IF IOST["C-"
WRITE @IOF
+3 SET PAGE=PAGE+1
+4 WRITE ?1,BKMVNDT,?70,"Page ",PAGE
+5 QUIT
HDR1 ;EP - PAGE 1 HEADER
+1 WRITE !,?80-$LENGTH(BKMHDR)\2,BKMHDR,!?1
+2 QUIT
HDR2 ;PAGE 1 ADDITIONAL LINE
+1 WRITE ?80-$LENGTH(BKMHDR1)\2,BKMHDR1,!?1
+2 QUIT
SECTIONI ;SECTION I PRINT
+1 SET BKMLINE=$PIECE(^BKM(90456,1,2,1,0),U,2)
SET BKMLINE1=$PIECE(^BKM(90456,1,2,1,0),U,3)
SET BKMSEC=$PIECE(^BKM(90456,1,2,1,0),U,1)
+2 IF $PIECE(^BKM(90456,1,2,1,0),U,4)'="Y"
QUIT
+3 WRITE !!?1,"SECTION I: ",BKMLINE,!?11,BKMLINE1,!?1
+4 FOR BKM=1:1:9
Begin DoDot:1
+5 IF $Y>(IOSL-4)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+6 SET BKMLINE=$PIECE(^BKM(90456,1,2,1,1,BKM,0),U,1)
SET BKMLINE1=$PIECE($GET(^BKM(90456,1,2,1,1,BKM,1,1,0)),U,1)
+7 DO LPRINT
End DoDot:1
IF BKMX
QUIT
+8 QUIT
LPRINT ;PRINT A LINE WITH DATA
+1 WRITE !?1,BKMLINE
IF BKMLINE1]""
WRITE " ",BKMLINE1
WRITE ": "
+2 IF BKM=1
WRITE $SELECT($GET(DFN)]"":$$GET1^DIQ(2,DFN,.01,"E"),1:"")
+3 IF BKM=2
WRITE $SELECT($DATA(BKMVPHN):BKMVPHN,1:"")
+4 IF BKM=3
WRITE $SELECT($DATA(BKMVADDL):BKMVADDL,1:"")
+5 IF BKM=4
WRITE $SELECT($DATA(BKMVHRN):BKMVHRN,1:"")
+6 IF BKM=5
WRITE $SELECT($DATA(BKMPROV):BKMPROV,1:"")
+7 IF BKM=6
WRITE $SELECT($DATA(BKMVPPH):BKMVPPH,1:"")
+8 IF BKM=7
WRITE $SELECT($DATA(BKMVLOC):BKMVLOC,1:"")
+9 ; No data to print for this field currently
IF BKM=8
+10 ; No data to print for this field currently
IF BKM=9
+11 QUIT
