BKMVSSR4 ;PRXM/HC/CLT - STATE SURV. REPORT PRINT CONTINUED ; 27 Apr 2005 1:05 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
;
EN ;EP - PRIMARY ROUTINE ENTRY POINT
D HDR^BKMVSSR3 Q:BKMX
D HDR1^BKMVSSR3
D SECTII Q:BKMX
D SECTIII Q:BKMX
D SECTIV Q:BKMX
Q
SECTII ;SECTION II PRINT
Q:$P(^BKM(90456,1,2,2,0),U,4)'="Y"
W !?1,"SECTION II: ",$P(^BKM(90456,1,2,2,0),U,2),!?1
F BKM=1:1:5 S BKMLINE=$P(^BKM(90456,1,2,2,1,BKM,0),U,1) D Q:BKMX
.I $Y>(IOSL-4) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
.W:$P(^BKM(90456,1,2,2,1,BKM,0),U,2)="Y" !?1,BKMLINE,":"
.D SECT2
Q
SECT2 ;PRINT BLANK DATA FIELDS
I $D(^BKM(90456,1,2,2,1,BKM,1)) D
.I $Y>(IOSL-$P(^BKM(90456,1,2,2,1,BKM,1,0),U,4)-2) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
.S BKM1=0 F S BKM1=$O(^BKM(90456,1,2,2,1,BKM,1,BKM1)) Q:'BKM1 D Q:BKMX
..I $Y>(IOSL-4) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
..S BKMLINE1=$P(^BKM(90456,1,2,2,1,BKM,1,BKM1,0),U,1)
..W !?1," ",BKMLINE1
Q
SECTIII ;SECTION III PRINT
Q:$P(^BKM(90456,1,2,3,0),U,4)'="Y"
W !!?1,"SECTION III: ",$P(^BKM(90456,1,2,3,0),U,2),!?1
F BKM=1:1:15 S BKMLINE=$P(^BKM(90456,1,2,3,1,BKM,0),U,1) D Q:BKMX
.I $Y>(IOSL-4) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
.W:$P(^BKM(90456,1,2,3,1,BKM,0),U,2)="Y" !?1,BKMLINE,": " D
..I BKM=1 W:$G(BKMDIAG)]"" BKMDIAG D:$G(BKMDIAG)="" SECT3 Q
..I BKM=2 W $S($D(BKMVAGED):BKMVAGED,1:"") Q
..I BKM=3 W:$G(BKMVDOB)]"" $$FMTE^XLFDT(BKMVDOB\1,"5Z") D:$G(BKMVDOB)="" SECT3 Q
..I BKM=4 W $S($D(BKMVSTAT):BKMVSTAT,1:"") D:'$D(BKMVSTAT) SECT3 Q ; Variable not yet defined
..I BKM=5 W:$G(BKMVDOD)]"" $$FMTE^XLFDT(BKMVDOD\1,"5Z") D:$G(BKMVDOD)="" SECT3 Q
..I BKM=6 W $G(BKMVSDTH) Q
..I BKM=7 W $G(BKMVSEX) Q
..I BKM=8 W:$G(BKMVETH)]"" BKMVETH D:$G(BKMVETH)="" SECT3 Q
..I BKM=9 W:$G(BKMVRCE)]"" BKMVRCE D:$G(BKMVRCE)="" SECT3 Q
..I BKM=10 W $S($D(BKMVPOB):$S(BKMVPOB<52:"U.S.A.",1:"OTHER"),1:"UNKNOWN") Q
..I BKM=11 ; No data to print for this field
..I BKM=12 W $S($D(BKMVCITY):BKMVCITY,1:"") Q
..I BKM=13 W $S($D(BKMVCNTY):BKMVCNTY,1:"") Q
..I BKM=14 W $S($D(BKMVPST):BKMVPST,1:"") Q
..I BKM=15 W $S($D(BKMVPZP):BKMVPZP,1:"") Q
Q
SECT3 ;PRINT BLANK DATA FIELDS
I $D(^BKM(90456,1,2,3,1,BKM,1)) D
.I $Y>(IOSL-$P(^BKM(90456,1,2,3,1,BKM,1,0),U,4)-2) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
.S BKM1=0 F S BKM1=$O(^BKM(90456,1,2,3,1,BKM,1,BKM1)) Q:'BKM1 D Q:BKMX
..I $Y>(IOSL-4) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
..S BKMLINE1=$P(^BKM(90456,1,2,3,1,BKM,1,BKM1,0),U,1)
..W !?1," ",BKMLINE1
Q
SECTIV ;SECTION IV PRINT
Q:$P(^BKM(90456,1,2,4,0),U,4)'="Y"
W !!?1,"SECTION IV: ",$P(^BKM(90456,1,2,4,0),U,2),!?1
F BKM=1:1:5 S BKMLINE=$P(^BKM(90456,1,2,4,1,BKM,0),U,1) D Q:BKMX
.I $Y>(IOSL-4) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
.W:$P(^BKM(90456,1,2,4,1,BKM,0),U,2)="Y" !?1,BKMLINE,": "
.I BKM=1 W $S($D(BKMVLOC):BKMVLOC,1:"") Q
.I BKM=2 W $S($D(BKMVLCTY):BKMVLCTY,1:"") Q
.I BKM=3 W $S($D(BKMVLST):BKMVLST,1:"") Q
.I BKM=4 D SECT4 Q
.I BKM=5 D SECT4 Q
Q
SECT4 ;PRINT BLANK DATA FIELDS
I $D(^BKM(90456,1,2,4,1,BKM,1)) D
.I $Y>(IOSL-$P(^BKM(90456,1,2,4,1,BKM,1,0),U,4)-2) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
.S BKM1=0 F S BKM1=$O(^BKM(90456,1,2,4,1,BKM,1,BKM1)) Q:'BKM1 D Q:BKMX
..I $Y>(IOSL-4) D HDR^BKMVSSR3 Q:BKMX D HDR1^BKMVSSR3
..S BKMLINE1=$P(^BKM(90456,1,2,4,1,BKM,1,BKM1,0),U,1)
..W !?1,BKMLINE1
Q
BKMVSSR4 ;PRXM/HC/CLT - STATE SURV. REPORT PRINT CONTINUED ; 27 Apr 2005 1:05 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ;
EN ;EP - PRIMARY ROUTINE ENTRY POINT
+1 DO HDR^BKMVSSR3
IF BKMX
QUIT
+2 DO HDR1^BKMVSSR3
+3 DO SECTII
IF BKMX
QUIT
+4 DO SECTIII
IF BKMX
QUIT
+5 DO SECTIV
IF BKMX
QUIT
+6 QUIT
SECTII ;SECTION II PRINT
+1 IF $PIECE(^BKM(90456,1,2,2,0),U,4)'="Y"
QUIT
+2 WRITE !?1,"SECTION II: ",$PIECE(^BKM(90456,1,2,2,0),U,2),!?1
+3 FOR BKM=1:1:5
SET BKMLINE=$PIECE(^BKM(90456,1,2,2,1,BKM,0),U,1)
Begin DoDot:1
+4 IF $Y>(IOSL-4)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+5 IF $PIECE(^BKM(90456,1,2,2,1,BKM,0),U,2)="Y"
WRITE !?1,BKMLINE,":"
+6 DO SECT2
End DoDot:1
IF BKMX
QUIT
+7 QUIT
SECT2 ;PRINT BLANK DATA FIELDS
+1 IF $DATA(^BKM(90456,1,2,2,1,BKM,1))
Begin DoDot:1
+2 IF $Y>(IOSL-$PIECE(^BKM(90456,1,2,2,1,BKM,1,0),U,4)-2)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+3 SET BKM1=0
FOR
SET BKM1=$ORDER(^BKM(90456,1,2,2,1,BKM,1,BKM1))
IF 'BKM1
QUIT
Begin DoDot:2
+4 IF $Y>(IOSL-4)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+5 SET BKMLINE1=$PIECE(^BKM(90456,1,2,2,1,BKM,1,BKM1,0),U,1)
+6 WRITE !?1," ",BKMLINE1
End DoDot:2
IF BKMX
QUIT
End DoDot:1
+7 QUIT
SECTIII ;SECTION III PRINT
+1 IF $PIECE(^BKM(90456,1,2,3,0),U,4)'="Y"
QUIT
+2 WRITE !!?1,"SECTION III: ",$PIECE(^BKM(90456,1,2,3,0),U,2),!?1
+3 FOR BKM=1:1:15
SET BKMLINE=$PIECE(^BKM(90456,1,2,3,1,BKM,0),U,1)
Begin DoDot:1
+4 IF $Y>(IOSL-4)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+5 IF $PIECE(^BKM(90456,1,2,3,1,BKM,0),U,2)="Y"
WRITE !?1,BKMLINE,": "
Begin DoDot:2
+6 IF BKM=1
IF $GET(BKMDIAG)]""
WRITE BKMDIAG
IF $GET(BKMDIAG)=""
DO SECT3
QUIT
+7 IF BKM=2
WRITE $SELECT($DATA(BKMVAGED):BKMVAGED,1:"")
QUIT
+8 IF BKM=3
IF $GET(BKMVDOB)]""
WRITE $$FMTE^XLFDT(BKMVDOB\1,"5Z")
IF $GET(BKMVDOB)=""
DO SECT3
QUIT
+9 ; Variable not yet defined
IF BKM=4
WRITE $SELECT($DATA(BKMVSTAT):BKMVSTAT,1:"")
IF '$DATA(BKMVSTAT)
DO SECT3
QUIT
+10 IF BKM=5
IF $GET(BKMVDOD)]""
WRITE $$FMTE^XLFDT(BKMVDOD\1,"5Z")
IF $GET(BKMVDOD)=""
DO SECT3
QUIT
+11 IF BKM=6
WRITE $GET(BKMVSDTH)
QUIT
+12 IF BKM=7
WRITE $GET(BKMVSEX)
QUIT
+13 IF BKM=8
IF $GET(BKMVETH)]""
WRITE BKMVETH
IF $GET(BKMVETH)=""
DO SECT3
QUIT
+14 IF BKM=9
IF $GET(BKMVRCE)]""
WRITE BKMVRCE
IF $GET(BKMVRCE)=""
DO SECT3
QUIT
+15 IF BKM=10
WRITE $SELECT($DATA(BKMVPOB):$SELECT(BKMVPOB<52:"U.S.A.",1:"OTHER"),1:"UNKNOWN")
QUIT
+16 ; No data to print for this field
IF BKM=11
+17 IF BKM=12
WRITE $SELECT($DATA(BKMVCITY):BKMVCITY,1:"")
QUIT
+18 IF BKM=13
WRITE $SELECT($DATA(BKMVCNTY):BKMVCNTY,1:"")
QUIT
+19 IF BKM=14
WRITE $SELECT($DATA(BKMVPST):BKMVPST,1:"")
QUIT
+20 IF BKM=15
WRITE $SELECT($DATA(BKMVPZP):BKMVPZP,1:"")
QUIT
End DoDot:2
End DoDot:1
IF BKMX
QUIT
+21 QUIT
SECT3 ;PRINT BLANK DATA FIELDS
+1 IF $DATA(^BKM(90456,1,2,3,1,BKM,1))
Begin DoDot:1
+2 IF $Y>(IOSL-$PIECE(^BKM(90456,1,2,3,1,BKM,1,0),U,4)-2)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+3 SET BKM1=0
FOR
SET BKM1=$ORDER(^BKM(90456,1,2,3,1,BKM,1,BKM1))
IF 'BKM1
QUIT
Begin DoDot:2
+4 IF $Y>(IOSL-4)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+5 SET BKMLINE1=$PIECE(^BKM(90456,1,2,3,1,BKM,1,BKM1,0),U,1)
+6 WRITE !?1," ",BKMLINE1
End DoDot:2
IF BKMX
QUIT
End DoDot:1
+7 QUIT
SECTIV ;SECTION IV PRINT
+1 IF $PIECE(^BKM(90456,1,2,4,0),U,4)'="Y"
QUIT
+2 WRITE !!?1,"SECTION IV: ",$PIECE(^BKM(90456,1,2,4,0),U,2),!?1
+3 FOR BKM=1:1:5
SET BKMLINE=$PIECE(^BKM(90456,1,2,4,1,BKM,0),U,1)
Begin DoDot:1
+4 IF $Y>(IOSL-4)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+5 IF $PIECE(^BKM(90456,1,2,4,1,BKM,0),U,2)="Y"
WRITE !?1,BKMLINE,": "
+6 IF BKM=1
WRITE $SELECT($DATA(BKMVLOC):BKMVLOC,1:"")
QUIT
+7 IF BKM=2
WRITE $SELECT($DATA(BKMVLCTY):BKMVLCTY,1:"")
QUIT
+8 IF BKM=3
WRITE $SELECT($DATA(BKMVLST):BKMVLST,1:"")
QUIT
+9 IF BKM=4
DO SECT4
QUIT
+10 IF BKM=5
DO SECT4
QUIT
End DoDot:1
IF BKMX
QUIT
+11 QUIT
SECT4 ;PRINT BLANK DATA FIELDS
+1 IF $DATA(^BKM(90456,1,2,4,1,BKM,1))
Begin DoDot:1
+2 IF $Y>(IOSL-$PIECE(^BKM(90456,1,2,4,1,BKM,1,0),U,4)-2)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+3 SET BKM1=0
FOR
SET BKM1=$ORDER(^BKM(90456,1,2,4,1,BKM,1,BKM1))
IF 'BKM1
QUIT
Begin DoDot:2
+4 IF $Y>(IOSL-4)
DO HDR^BKMVSSR3
IF BKMX
QUIT
DO HDR1^BKMVSSR3
+5 SET BKMLINE1=$PIECE(^BKM(90456,1,2,4,1,BKM,1,BKM1,0),U,1)
+6 WRITE !?1,BKMLINE1
End DoDot:2
IF BKMX
QUIT
End DoDot:1
+7 QUIT
