- BKMQSSR4 ;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 UPD^BKMQUTL("")
- D SECTII
- D SECTIII
- D SECTIV
- Q
- SECTII ;SECTION II PRINT
- Q:$P(^BKM(90456,1,2,2,0),U,4)'="Y"
- D UPD^BKMQUTL(" 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 $P(^BKM(90456,1,2,2,1,BKM,0),U,2)="Y" D UPD^BKMQUTL(" "_BKMLINE_":")
- . D SECT2
- Q
- SECT2 ;PRINT BLANK DATA FIELDS
- I $D(^BKM(90456,1,2,2,1,BKM,1)) D
- . S BKM1=0
- . F S BKM1=$O(^BKM(90456,1,2,2,1,BKM,1,BKM1)) Q:'BKM1 D ;Q:BKMX
- .. S BKMLINE1=$P(^BKM(90456,1,2,2,1,BKM,1,BKM1,0),U,1)
- .. D UPD^BKMQUTL(" "_BKMLINE1)
- Q
- SECTIII ;SECTION III PRINT
- N LINE
- Q:$P(^BKM(90456,1,2,3,0),U,4)'="Y"
- D UPD^BKMQUTL(""),UPD^BKMQUTL(" SECTION III: "_$P(^BKM(90456,1,2,3,0),U,2))
- D UPD^BKMQUTL("")
- S LINE=""
- F BKM=1:1:15 S BKMLINE=$P(^BKM(90456,1,2,3,1,BKM,0),U,1) D ;Q:BKMX
- . I $P(^BKM(90456,1,2,3,1,BKM,0),U,2)="Y" S LINE=" "_BKMLINE_": " D
- .. I BKM=1 D Q
- ... I $G(BKMDIAG)]"" S LINE=LINE_BKMDIAG
- ... D UPD^BKMQUTL(LINE)
- ... D:$G(BKMDIAG)="" SECT3
- .. I BKM=2 D UPD^BKMQUTL(LINE_$S($D(BKMVAGED):BKMVAGED,1:"")) Q
- .. I BKM=3 D Q
- ... I $G(BKMVDOB)]"" S LINE=LINE_$$FMTE^XLFDT(BKMVDOB\1,"5Z")
- ... D UPD^BKMQUTL(LINE)
- ... D:$G(BKMVDOB)="" SECT3
- .. I BKM=4 D UPD^BKMQUTL(LINE_$S($D(BKMVSTAT):BKMVSTAT,1:"")) D:'$D(BKMVSTAT) SECT3 Q ; Variable not yet defined
- .. I BKM=5 D Q
- ... I $G(BKMVDOD)]"" S LINE=LINE_$$FMTE^XLFDT(BKMVDOD\1,"5Z")
- ... D UPD^BKMQUTL(LINE)
- ... D:$G(BKMVDOD)="" SECT3
- .. I BKM=6 D UPD^BKMQUTL(LINE_$G(BKMVSDTH)) Q
- .. I BKM=7 D UPD^BKMQUTL(LINE_$G(BKMVSEX)) Q
- .. I BKM=8 D Q
- ... I $G(BKMVETH)]"" S LINE=LINE_BKMVETH
- ... D UPD^BKMQUTL(LINE)
- ... D:$G(BKMVETH)="" SECT3
- .. I BKM=9 D Q
- ... I $G(BKMVRCE)]"" S LINE=LINE_BKMVRCE
- ... D UPD^BKMQUTL(LINE)
- ... D:$G(BKMVRCE)="" SECT3
- .. I BKM=10 D UPD^BKMQUTL(LINE_$S($D(BKMVPOB):$S(BKMVPOB<52:"U.S.A.",1:"OTHER"),1:"UNKNOWN")) Q
- .. I BKM=11 D UPD^BKMQUTL(LINE) ; No data to print for this field
- .. I BKM=12 D UPD^BKMQUTL(LINE_$S($D(BKMVCITY):BKMVCITY,1:"")) Q
- .. I BKM=13 D UPD^BKMQUTL(LINE_$S($D(BKMVCNTY):BKMVCNTY,1:"")) Q
- .. I BKM=14 D UPD^BKMQUTL(LINE_$S($D(BKMVPST):BKMVPST,1:"")) Q
- .. I BKM=15 D UPD^BKMQUTL(LINE_$S($D(BKMVPZP):BKMVPZP,1:"")) Q
- Q
- SECT3 ;PRINT BLANK DATA FIELDS
- I $D(^BKM(90456,1,2,3,1,BKM,1)) D
- . S BKM1=0
- . F S BKM1=$O(^BKM(90456,1,2,3,1,BKM,1,BKM1)) Q:'BKM1 D ;Q:BKMX
- .. S BKMLINE1=$P(^BKM(90456,1,2,3,1,BKM,1,BKM1,0),U,1)
- .. D UPD^BKMQUTL(" "_BKMLINE1)
- Q
- SECTIV ;SECTION IV PRINT
- Q:$P(^BKM(90456,1,2,4,0),U,4)'="Y"
- D UPD^BKMQUTL(""),UPD^BKMQUTL(" SECTION IV: "_$P(^BKM(90456,1,2,4,0),U,2))
- D UPD^BKMQUTL("")
- F BKM=1:1:5 S BKMLINE=$P(^BKM(90456,1,2,4,1,BKM,0),U,1) D ;Q:BKMX
- . I $P(^BKM(90456,1,2,4,1,BKM,0),U,2)="Y" S LINE=BKMLINE_": "
- . I BKM=1 D UPD^BKMQUTL(LINE_$S($D(BKMVLOC):BKMVLOC,1:"")) Q
- . I BKM=2 D UPD^BKMQUTL(LINE_$S($D(BKMVLCTY):BKMVLCTY,1:"")) Q
- . I BKM=3 D UPD^BKMQUTL(LINE_$S($D(BKMVLST):BKMVLST,1:"")) Q
- . I BKM=4 D UPD^BKMQUTL(LINE) D SECT4 Q
- . I BKM=5 D UPD^BKMQUTL(LINE) D SECT4 Q
- Q
- SECT4 ;PRINT BLANK DATA FIELDS
- I $D(^BKM(90456,1,2,4,1,BKM,1)) D
- . S BKM1=0
- . F S BKM1=$O(^BKM(90456,1,2,4,1,BKM,1,BKM1)) Q:'BKM1 D ;Q:BKMX
- .. S BKMLINE1=$P(^BKM(90456,1,2,4,1,BKM,1,BKM1,0),U,1)
- .. D UPD^BKMQUTL(" "_BKMLINE1)
- Q
- BKMQSSR4 ;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 UPD^BKMQUTL("")
- +2 DO SECTII
- +3 DO SECTIII
- +4 DO SECTIV
- +5 QUIT
- SECTII ;SECTION II PRINT
- +1 IF $PIECE(^BKM(90456,1,2,2,0),U,4)'="Y"
- QUIT
- +2 DO UPD^BKMQUTL(" SECTION II: "_$PIECE(^BKM(90456,1,2,2,0),U,2),1)
- +3 ;Q:BKMX
- FOR BKM=1:1:5
- SET BKMLINE=$PIECE(^BKM(90456,1,2,2,1,BKM,0),U,1)
- Begin DoDot:1
- +4 IF $PIECE(^BKM(90456,1,2,2,1,BKM,0),U,2)="Y"
- DO UPD^BKMQUTL(" "_BKMLINE_":")
- +5 DO SECT2
- End DoDot:1
- +6 QUIT
- SECT2 ;PRINT BLANK DATA FIELDS
- +1 IF $DATA(^BKM(90456,1,2,2,1,BKM,1))
- Begin DoDot:1
- +2 SET BKM1=0
- +3 ;Q:BKMX
- FOR
- SET BKM1=$ORDER(^BKM(90456,1,2,2,1,BKM,1,BKM1))
- IF 'BKM1
- QUIT
- Begin DoDot:2
- +4 SET BKMLINE1=$PIECE(^BKM(90456,1,2,2,1,BKM,1,BKM1,0),U,1)
- +5 DO UPD^BKMQUTL(" "_BKMLINE1)
- End DoDot:2
- End DoDot:1
- +6 QUIT
- SECTIII ;SECTION III PRINT
- +1 NEW LINE
- +2 IF $PIECE(^BKM(90456,1,2,3,0),U,4)'="Y"
- QUIT
- +3 DO UPD^BKMQUTL("")
- DO UPD^BKMQUTL(" SECTION III: "_$PIECE(^BKM(90456,1,2,3,0),U,2))
- +4 DO UPD^BKMQUTL("")
- +5 SET LINE=""
- +6 ;Q:BKMX
- FOR BKM=1:1:15
- SET BKMLINE=$PIECE(^BKM(90456,1,2,3,1,BKM,0),U,1)
- Begin DoDot:1
- +7 IF $PIECE(^BKM(90456,1,2,3,1,BKM,0),U,2)="Y"
- SET LINE=" "_BKMLINE_": "
- Begin DoDot:2
- +8 IF BKM=1
- Begin DoDot:3
- +9 IF $GET(BKMDIAG)]""
- SET LINE=LINE_BKMDIAG
- +10 DO UPD^BKMQUTL(LINE)
- +11 IF $GET(BKMDIAG)=""
- DO SECT3
- End DoDot:3
- QUIT
- +12 IF BKM=2
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVAGED):BKMVAGED,1:""))
- QUIT
- +13 IF BKM=3
- Begin DoDot:3
- +14 IF $GET(BKMVDOB)]""
- SET LINE=LINE_$$FMTE^XLFDT(BKMVDOB\1,"5Z")
- +15 DO UPD^BKMQUTL(LINE)
- +16 IF $GET(BKMVDOB)=""
- DO SECT3
- End DoDot:3
- QUIT
- +17 ; Variable not yet defined
- IF BKM=4
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVSTAT):BKMVSTAT,1:""))
- IF '$DATA(BKMVSTAT)
- DO SECT3
- QUIT
- +18 IF BKM=5
- Begin DoDot:3
- +19 IF $GET(BKMVDOD)]""
- SET LINE=LINE_$$FMTE^XLFDT(BKMVDOD\1,"5Z")
- +20 DO UPD^BKMQUTL(LINE)
- +21 IF $GET(BKMVDOD)=""
- DO SECT3
- End DoDot:3
- QUIT
- +22 IF BKM=6
- DO UPD^BKMQUTL(LINE_$GET(BKMVSDTH))
- QUIT
- +23 IF BKM=7
- DO UPD^BKMQUTL(LINE_$GET(BKMVSEX))
- QUIT
- +24 IF BKM=8
- Begin DoDot:3
- +25 IF $GET(BKMVETH)]""
- SET LINE=LINE_BKMVETH
- +26 DO UPD^BKMQUTL(LINE)
- +27 IF $GET(BKMVETH)=""
- DO SECT3
- End DoDot:3
- QUIT
- +28 IF BKM=9
- Begin DoDot:3
- +29 IF $GET(BKMVRCE)]""
- SET LINE=LINE_BKMVRCE
- +30 DO UPD^BKMQUTL(LINE)
- +31 IF $GET(BKMVRCE)=""
- DO SECT3
- End DoDot:3
- QUIT
- +32 IF BKM=10
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVPOB):$SELECT(BKMVPOB<52:"U.S.A.",1:"OTHER"),1:"UNKNOWN"))
- QUIT
- +33 ; No data to print for this field
- IF BKM=11
- DO UPD^BKMQUTL(LINE)
- +34 IF BKM=12
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVCITY):BKMVCITY,1:""))
- QUIT
- +35 IF BKM=13
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVCNTY):BKMVCNTY,1:""))
- QUIT
- +36 IF BKM=14
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVPST):BKMVPST,1:""))
- QUIT
- +37 IF BKM=15
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVPZP):BKMVPZP,1:""))
- QUIT
- End DoDot:2
- End DoDot:1
- +38 QUIT
- SECT3 ;PRINT BLANK DATA FIELDS
- +1 IF $DATA(^BKM(90456,1,2,3,1,BKM,1))
- Begin DoDot:1
- +2 SET BKM1=0
- +3 ;Q:BKMX
- FOR
- SET BKM1=$ORDER(^BKM(90456,1,2,3,1,BKM,1,BKM1))
- IF 'BKM1
- QUIT
- Begin DoDot:2
- +4 SET BKMLINE1=$PIECE(^BKM(90456,1,2,3,1,BKM,1,BKM1,0),U,1)
- +5 DO UPD^BKMQUTL(" "_BKMLINE1)
- End DoDot:2
- End DoDot:1
- +6 QUIT
- SECTIV ;SECTION IV PRINT
- +1 IF $PIECE(^BKM(90456,1,2,4,0),U,4)'="Y"
- QUIT
- +2 DO UPD^BKMQUTL("")
- DO UPD^BKMQUTL(" SECTION IV: "_$PIECE(^BKM(90456,1,2,4,0),U,2))
- +3 DO UPD^BKMQUTL("")
- +4 ;Q:BKMX
- FOR BKM=1:1:5
- SET BKMLINE=$PIECE(^BKM(90456,1,2,4,1,BKM,0),U,1)
- Begin DoDot:1
- +5 IF $PIECE(^BKM(90456,1,2,4,1,BKM,0),U,2)="Y"
- SET LINE=BKMLINE_": "
- +6 IF BKM=1
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVLOC):BKMVLOC,1:""))
- QUIT
- +7 IF BKM=2
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVLCTY):BKMVLCTY,1:""))
- QUIT
- +8 IF BKM=3
- DO UPD^BKMQUTL(LINE_$SELECT($DATA(BKMVLST):BKMVLST,1:""))
- QUIT
- +9 IF BKM=4
- DO UPD^BKMQUTL(LINE)
- DO SECT4
- QUIT
- +10 IF BKM=5
- DO UPD^BKMQUTL(LINE)
- DO SECT4
- QUIT
- End DoDot:1
- +11 QUIT
- SECT4 ;PRINT BLANK DATA FIELDS
- +1 IF $DATA(^BKM(90456,1,2,4,1,BKM,1))
- Begin DoDot:1
- +2 SET BKM1=0
- +3 ;Q:BKMX
- FOR
- SET BKM1=$ORDER(^BKM(90456,1,2,4,1,BKM,1,BKM1))
- IF 'BKM1
- QUIT
- Begin DoDot:2
- +4 SET BKMLINE1=$PIECE(^BKM(90456,1,2,4,1,BKM,1,BKM1,0),U,1)
- +5 DO UPD^BKMQUTL(" "_BKMLINE1)
- End DoDot:2
- End DoDot:1
- +6 QUIT
