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
