- BUDHRPTQ ;IHS/CMI/LAB - UDS REPORT PRINT;
- ;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
- ;
- C(X,Y) ;
- I $G(Y)=1,+X=0 Q ""
- I $G(Y)=2 Q "********"
- S X2=0,X3=8
- D COMMA^%DTC
- Q X
- REST3B ;EP
- S BUDLANG=1
- I $Y>(IOSL-7) D HEADER^BUDHRPTP Q:BUDQUIT D T3BSH
- W !!,BUD80L,!?61,"NUMBER"
- W !,"PATIENTS BY LINGUISTIC BARRIERS TO CARE",?63,"(a)",!,BUD80L
- W !?2,"12.",?7,"Patients Best Served in a Language",!?7," Other Than English",?60,$$C($P(BUDLANG(12),U,2)),!,BUD80L
- I $Y>(IOSL-12) D HEADER^BUDHRPTP Q:BUDQUIT D T3BSH
- W !!,BUD80L,!?61,"NUMBER"
- W !,"PATIENTS BY SEXUAL ORIENTATION",?63,"(a)",!,BUD80L
- F BUDX=13:1:19 Q:BUDQUIT D
- .I $Y>(IOSL-3) D HEADER^BUDHRPTP Q:BUDQUIT D T3BSH
- .W !?2,$P(BUDSOT(BUDX),U),?7,$P(BUDSOT(BUDX),U,2)
- .I $P(BUDSOT(BUDX),U,7)]"" W !?7,$P(BUDSOT(BUDX),U,7)
- .I $P(BUDSOT(BUDX),U,8)]"" W !?7,$P(BUDSOT(BUDX),U,8)
- .I $P(BUDSOT(BUDX),U,9)]"" W !?7,$P(BUDSOT(BUDX),U,9)
- .I $P(BUDSOT(BUDX),U,3)]"" W ?60,$$C($P(BUDSOT(BUDX),U,3))
- .W !,BUD80L
- ;GENDER IDENTITY PRINT
- I $Y>(IOSL-12) D HEADER^BUDHRPTP Q:BUDQUIT D T3BSH
- W !!,BUD80L,!?61,"NUMBER"
- W !,"PATIENTS BY GENDER IDENTITY",?63,"(a)",!,BUD80L
- F BUDX=20:1:26 Q:BUDQUIT D
- .I $Y>(IOSL-3) D HEADER^BUDHRPTP Q:BUDQUIT D T3BSH
- .W !?2,$P(BUDGIDT(BUDX),U),?7,$P(BUDGIDT(BUDX),U,2)
- .I $P(BUDGIDT(BUDX),U,7)]"" W !?7,$P(BUDGIDT(BUDX),U,7)
- .I $P(BUDGIDT(BUDX),U,8)]"" W !?7,$P(BUDGIDT(BUDX),U,8)
- .I $P(BUDGIDT(BUDX),U,9)]"" W !?7,$P(BUDGIDT(BUDX),U,9)
- .I $P(BUDGIDT(BUDX),U,3)]"" W ?60,$$C($P(BUDGIDT(BUDX),U,3))
- .W !,BUD80L
- Q
- T3BSH ;
- W !!,$$CTR("TABLE 3B -",80)
- W !,$$CTR("DEMOGRAPHIC CHARACTERISTICS",80),!,$$CTR("Patients by Race and Hispanic or Latino Ethnicity",80),!,BUD80L
- Q
- CTR(X,Y) ;EP - Center X in a field Y wide.
- Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
- ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- ;----------
- WDEL ;EP - WRITE T9 DELIMITED FILE
- ;call xbgsave to create output file
- S XBGL="BUDDATA"
- L +^BUDDATA:300 E W:'$D(ZTQUEUED) "Unable to lock global" Q
- K ^TMP($J,"SUMMARYDEL")
- K ^BUDDATA ;global for saving
- D COVPAGED^BUDHUTL1
- S C=C+1
- S ^BUDDATA(C)="***** SENSITIVE INFORMATION *****"
- S X="DATE^BILL (A/R)^TRANSACTION TYPE^CREDIT^DEBIT^PRIME BILL AMOUNT^PAYMENT^ADJUSTMENT^ADJUSTMENT CATEGORY^ADJUSTMENT TYPE^A/R ACCOUNT^PAYER CATEGORY^PATIENT (A/R)^VISIT LOCATION^CLINIC TYPE^DOS BEGIN^BILL TYPE^PRIMARY PROVIDER^"
- S X=X_"HRN^DOB^COMMUNITY"
- S C=C+1,^BUDDATA(C)=X
- S D=0 F S D=$O(^XTMP("BUDARP9DEL",BUDJ,BUDH,D)) Q:D'=+D D
- .S X=0 F S X=$O(^XTMP("BUDARP9DEL",BUDJ,BUDH,D,X)) Q:X'=+X D
- ..S C=C+1 S ^BUDDATA(C)=^XTMP("BUDARP9DEL",BUDJ,BUDH,D,X)
- S X="***** END OF REPORT *****",C=C+1,^BUDDATA(C)=X
- S XBFLT=1,XBFN=BUDFILE_".txt",XBMED="F",XBTLE="UDS TABLE 9D DELIMITED",XBQ="N",XBF=0
- D ^XBGSAVE
- K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
- L -^BUDDATA
- K ^BUDDATA ;export global
- Q
- BUDHRPTQ ;IHS/CMI/LAB - UDS REPORT PRINT;
- +1 ;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
- +2 ;
- C(X,Y) ;
- +1 IF $GET(Y)=1
- IF +X=0
- QUIT ""
- +2 IF $GET(Y)=2
- QUIT "********"
- +3 SET X2=0
- SET X3=8
- +4 DO COMMA^%DTC
- +5 QUIT X
- REST3B ;EP
- +1 SET BUDLANG=1
- +2 IF $Y>(IOSL-7)
- DO HEADER^BUDHRPTP
- IF BUDQUIT
- QUIT
- DO T3BSH
- +3 WRITE !!,BUD80L,!?61,"NUMBER"
- +4 WRITE !,"PATIENTS BY LINGUISTIC BARRIERS TO CARE",?63,"(a)",!,BUD80L
- +5 WRITE !?2,"12.",?7,"Patients Best Served in a Language",!?7," Other Than English",?60,$$C($PIECE(BUDLANG(12),U,2)),!,BUD80L
- +6 IF $Y>(IOSL-12)
- DO HEADER^BUDHRPTP
- IF BUDQUIT
- QUIT
- DO T3BSH
- +7 WRITE !!,BUD80L,!?61,"NUMBER"
- +8 WRITE !,"PATIENTS BY SEXUAL ORIENTATION",?63,"(a)",!,BUD80L
- +9 FOR BUDX=13:1:19
- IF BUDQUIT
- QUIT
- Begin DoDot:1
- +10 IF $Y>(IOSL-3)
- DO HEADER^BUDHRPTP
- IF BUDQUIT
- QUIT
- DO T3BSH
- +11 WRITE !?2,$PIECE(BUDSOT(BUDX),U),?7,$PIECE(BUDSOT(BUDX),U,2)
- +12 IF $PIECE(BUDSOT(BUDX),U,7)]""
- WRITE !?7,$PIECE(BUDSOT(BUDX),U,7)
- +13 IF $PIECE(BUDSOT(BUDX),U,8)]""
- WRITE !?7,$PIECE(BUDSOT(BUDX),U,8)
- +14 IF $PIECE(BUDSOT(BUDX),U,9)]""
- WRITE !?7,$PIECE(BUDSOT(BUDX),U,9)
- +15 IF $PIECE(BUDSOT(BUDX),U,3)]""
- WRITE ?60,$$C($PIECE(BUDSOT(BUDX),U,3))
- +16 WRITE !,BUD80L
- End DoDot:1
- +17 ;GENDER IDENTITY PRINT
- +18 IF $Y>(IOSL-12)
- DO HEADER^BUDHRPTP
- IF BUDQUIT
- QUIT
- DO T3BSH
- +19 WRITE !!,BUD80L,!?61,"NUMBER"
- +20 WRITE !,"PATIENTS BY GENDER IDENTITY",?63,"(a)",!,BUD80L
- +21 FOR BUDX=20:1:26
- IF BUDQUIT
- QUIT
- Begin DoDot:1
- +22 IF $Y>(IOSL-3)
- DO HEADER^BUDHRPTP
- IF BUDQUIT
- QUIT
- DO T3BSH
- +23 WRITE !?2,$PIECE(BUDGIDT(BUDX),U),?7,$PIECE(BUDGIDT(BUDX),U,2)
- +24 IF $PIECE(BUDGIDT(BUDX),U,7)]""
- WRITE !?7,$PIECE(BUDGIDT(BUDX),U,7)
- +25 IF $PIECE(BUDGIDT(BUDX),U,8)]""
- WRITE !?7,$PIECE(BUDGIDT(BUDX),U,8)
- +26 IF $PIECE(BUDGIDT(BUDX),U,9)]""
- WRITE !?7,$PIECE(BUDGIDT(BUDX),U,9)
- +27 IF $PIECE(BUDGIDT(BUDX),U,3)]""
- WRITE ?60,$$C($PIECE(BUDGIDT(BUDX),U,3))
- +28 WRITE !,BUD80L
- End DoDot:1
- +29 QUIT
- T3BSH ;
- +1 WRITE !!,$$CTR("TABLE 3B -",80)
- +2 WRITE !,$$CTR("DEMOGRAPHIC CHARACTERISTICS",80),!,$$CTR("Patients by Race and Hispanic or Latino Ethnicity",80),!,BUD80L
- +3 QUIT
- CTR(X,Y) ;EP - Center X in a field Y wide.
- +1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
- +2 ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- +1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- +2 ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- +1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- +2 ;----------
- WDEL ;EP - WRITE T9 DELIMITED FILE
- +1 ;call xbgsave to create output file
- +2 SET XBGL="BUDDATA"
- +3 LOCK +^BUDDATA:300
- IF '$TEST
- IF '$DATA(ZTQUEUED)
- WRITE "Unable to lock global"
- QUIT
- +4 KILL ^TMP($JOB,"SUMMARYDEL")
- +5 ;global for saving
- KILL ^BUDDATA
- +6 DO COVPAGED^BUDHUTL1
- +7 SET C=C+1
- +8 SET ^BUDDATA(C)="***** SENSITIVE INFORMATION *****"
- +9 SET X="DATE^BILL (A/R)^TRANSACTION TYPE^CREDIT^DEBIT^PRIME BILL AMOUNT^PAYMENT^ADJUSTMENT^ADJUSTMENT CATEGORY^ADJUSTMENT TYPE^A/R ACCOUNT^PAYER CATEGORY^PATIENT (A/R)^VISIT LOCATION^CLINIC TYPE^DOS BEGIN^BILL TYPE^PRIMARY PROVIDER^"
- +10 SET X=X_"HRN^DOB^COMMUNITY"
- +11 SET C=C+1
- SET ^BUDDATA(C)=X
- +12 SET D=0
- FOR
- SET D=$ORDER(^XTMP("BUDARP9DEL",BUDJ,BUDH,D))
- IF D'=+D
- QUIT
- Begin DoDot:1
- +13 SET X=0
- FOR
- SET X=$ORDER(^XTMP("BUDARP9DEL",BUDJ,BUDH,D,X))
- IF X'=+X
- QUIT
- Begin DoDot:2
- +14 SET C=C+1
- SET ^BUDDATA(C)=^XTMP("BUDARP9DEL",BUDJ,BUDH,D,X)
- End DoDot:2
- End DoDot:1
- +15 SET X="***** END OF REPORT *****"
- SET C=C+1
- SET ^BUDDATA(C)=X
- +16 SET XBFLT=1
- SET XBFN=BUDFILE_".txt"
- SET XBMED="F"
- SET XBTLE="UDS TABLE 9D DELIMITED"
- SET XBQ="N"
- SET XBF=0
- +17 DO ^XBGSAVE
- +18 KILL XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
- +19 LOCK -^BUDDATA
- +20 ;export global
- KILL ^BUDDATA
- +21 QUIT
