- 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
