- 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
