BKMQSSR3.m

BKMQSSR3 ;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_"*"

 I BKMHDR1'="" S BKMHDR1="********** "_BKMHDR1_" **********"

 S BKMVNDT=$$FMTE^XLFDT($$DT^XLFDT(),"5Z")

 S PAGE=0,BKMX=0

 D HDR

 D HDR1,HDR2,UPD^BKMQUTL(""),SUBHEAD

 D SECTIONI,UPD^BKMQUTL($C(12),,1)

 Q

SUBHEAD ;PAGE 1 SUBHEADER

 S BKMLINE=0

 F  S BKMLINE=$O(^BKM(90456,1,1,BKMLINE)) Q:'BKMLINE  S X=^BKM(90456,1,1,BKMLINE,0) D UPD^BKMQUTL("    "_X) ; D ^DIWP ;D:$Y>(IOSL-2) HDR^BKMQSSR3 ;Q:BKMX

 Q

HDR ;EP - REPORT MAIN HEADER

 S PAGE=PAGE+1

 N LINE

 D UPD^BKMQUTL($$LINE^BKMQUTL(" "_BKMVNDT,"Page "_PAGE,70))

 Q

HDR1 ;EP - PAGE 1 HEADER

 D CTR^BKMQUTL(BKMHDR)

 Q

HDR2 ;PAGE 1 ADDITIONAL LINE

 Q:BKMHDR1=""

 D CTR^BKMQUTL(BKMHDR1)

 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"

 D UPD^BKMQUTL("",1),UPD^BKMQUTL("SECTION I: "_BKMLINE)

 D UPD^BKMQUTL($$LINE^BKMQUTL("",BKMLINE1,11),1)

 F BKM=1:1:9 D

 .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

 N LINE

 S LINE=" "_BKMLINE

 I BKMLINE1'="" S LINE=LINE_" "_BKMLINE1

 S LINE=LINE_": "

 I BKM=1 S LINE=LINE_$S($G(DFN)]"":$$GET1^DIQ(2,DFN,.01,"E"),1:"")

 I BKM=2 S LINE=LINE_$S($D(BKMVPHN):BKMVPHN,1:"")

 I BKM=3 S LINE=LINE_$S($D(BKMVADDL):BKMVADDL,1:"")

 I BKM=4 S LINE=LINE_$S($D(BKMVHRN):BKMVHRN,1:"")

 I BKM=5 S LINE=LINE_$S($D(BKMPROV):BKMPROV,1:"")

 I BKM=6 S LINE=LINE_$S($D(BKMVPPH):BKMVPPH,1:"")

 I BKM=7 S LINE=LINE_$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

 D UPD^BKMQUTL(LINE)

 Q

BKMQSSR3  ;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        IF BKMHDR1'=""

               SET BKMHDR1="********** "_BKMHDR1_" **********"

 +6        SET BKMVNDT=$$FMTE^XLFDT($$DT^XLFDT(),"5Z")

 +7        SET PAGE=0

           SET BKMX=0

 +8        DO HDR

 +9        DO HDR1

           DO HDR2

           DO UPD^BKMQUTL("")

           DO SUBHEAD

 +10       DO SECTIONI

           DO UPD^BKMQUTL($CHAR(12),,1)

 +11       QUIT 

SUBHEAD   ;PAGE 1 SUBHEADER

 +1        SET BKMLINE=0

 +2       ; D ^DIWP ;D:$Y>(IOSL-2) HDR^BKMQSSR3 ;Q:BKMX

           FOR 

               SET BKMLINE=$ORDER(^BKM(90456,1,1,BKMLINE))

               IF 'BKMLINE

                   QUIT 

               SET X=^BKM(90456,1,1,BKMLINE,0)

               DO UPD^BKMQUTL("    "_X)

 +3        QUIT 

HDR       ;EP - REPORT MAIN HEADER

 +1        SET PAGE=PAGE+1

 +2        NEW LINE

 +3        DO UPD^BKMQUTL($$LINE^BKMQUTL(" "_BKMVNDT,"Page "_PAGE,70))

 +4        QUIT 

HDR1      ;EP - PAGE 1 HEADER

 +1        DO CTR^BKMQUTL(BKMHDR)

 +2        QUIT 

HDR2      ;PAGE 1 ADDITIONAL LINE

 +1        IF BKMHDR1=""

               QUIT 

 +2        DO CTR^BKMQUTL(BKMHDR1)

 +3        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        DO UPD^BKMQUTL("",1)

           DO UPD^BKMQUTL("SECTION I: "_BKMLINE)

 +4        DO UPD^BKMQUTL($$LINE^BKMQUTL("",BKMLINE1,11),1)

 +5        FOR BKM=1:1:9

               Begin DoDot:1

 +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

 +8        QUIT 

LPRINT    ;PRINT A LINE WITH DATA

 +1        NEW LINE

 +2        SET LINE=" "_BKMLINE

 +3        IF BKMLINE1'=""

               SET LINE=LINE_" "_BKMLINE1

 +4        SET LINE=LINE_": "

 +5        IF BKM=1

               SET LINE=LINE_$SELECT($GET(DFN)]"":$$GET1^DIQ(2,DFN,.01,"E"),1:"")

 +6        IF BKM=2

               SET LINE=LINE_$SELECT($DATA(BKMVPHN):BKMVPHN,1:"")

 +7        IF BKM=3

               SET LINE=LINE_$SELECT($DATA(BKMVADDL):BKMVADDL,1:"")

 +8        IF BKM=4

               SET LINE=LINE_$SELECT($DATA(BKMVHRN):BKMVHRN,1:"")

 +9        IF BKM=5

               SET LINE=LINE_$SELECT($DATA(BKMPROV):BKMPROV,1:"")

 +10       IF BKM=6

               SET LINE=LINE_$SELECT($DATA(BKMVPPH):BKMVPPH,1:"")

 +11       IF BKM=7

               SET LINE=LINE_$SELECT($DATA(BKMVLOC):BKMVLOC,1:"")

 +12      ; No data to print for this field currently

           IF BKM=8

 +13      ; No data to print for this field currently

           IF BKM=9

 +14       DO UPD^BKMQUTL(LINE)

 +15       QUIT