ABMMUEL1.m

ABMMUEL1 ;IHS/SD/SDR - Meaningful Use Report - count patients/eligibility ;

 ;;2.6;IHS 3P BILLING SYSTEM;**12,15,21**;NOV 12, 2009;Build 379

 ;IHS/SD/SDR - 2.6*15 - HEAT188495 - Fixed policy holder so it will print all the time; defaulted to policy number from policy holder file the

 ;  same way Reg does

 ;IHS/SD/SDR - 2.6*15 - HEAT188548 - Formatted visit/admit date/time for VISIT section

 ;IHS/SD/SDR - 2.6*21 - HEAT204790 - Added code to stop error <SUBSCR>WRTELIG+55^ABMMUEL1.  Occurs when Private Insurance Eligible entry doesn't

 ;   have a coinsiding Policy Holder entry.

 ;

WRTPTS ;^TMP($J,"ABM-MURPT","PTS",ABMP("PDFN"))

 W !!!,"PATIENTS PATIENTS PATIENTS PATIENTS PATIENTS"

 W !?3,"PDFN",?15,"NAME",?50,"HRN",?60,"DATE INACTIVE"

 S ABMP("PDFN")=0

 F  S ABMP("PDFN")=$O(^TMP($J,"ABM-MURPT","PTS",ABMP("PDFN"))) Q:'ABMP("PDFN")  D

 .W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2),?60,$$SDT^ABMDUTL($P($G(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,3))

 ;

 ;^TMP($J,"ABM-MURPT","UNQ",ABMPT)

 W !!!,"UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS"

 W !?3,"PDFN",?15,"NAME",?50,"HRN"

 S ABMP("PDFN")=0

 F  S ABMP("PDFN")=$O(^TMP($J,"ABM-MURPT","UNQ",ABMP("PDFN"))) Q:'ABMP("PDFN")  D

 .W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2)

 Q

 ;

WRTELIG ;

 ;^TMP($J,"ABM-MURPT","MCD",ABMP("PDFN"),ABMP("MDFN"))

 W !!!,"MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID "

 W !?3,"PDFN",?15,"NAME",?50,"MCD#",?81,"PLAN"

 S ABMP("PDFN")=0

 F  S ABMP("PDFN")=$O(^TMP($J,"ABM-MURPT","MCD",ABMP("PDFN"))) Q:'ABMP("PDFN")  D

 .S ABMP("MDFN")=0

 .F  S ABMP("MDFN")=$O(^TMP($J,"ABM-MURPT","MCD",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN")  D

 ..;W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,3),?62,$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,10)  ;abm*2.6*15 HEAT188548

 ..;abm*2.6*15 HEAT188548 below line - Expanded mcd# and wrote ins name w/#

 ..W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,3)

 ..W:$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,10) ?81,$P($G(^AUTNINS($P($G(^AUPNMCD(ABMP("MDFN"),0)),U,10),0)),U)_" ("_$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,10)_")"  ;abm*2.6*15 HEAT188548

 ;

 ;^TMP($J,"ABM-MURPT","MCR",ABMP("PDFN"),ABMP("MDFN"))

 W !!!,"MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE "

 W !?3,"PDFN",?15,"NAME",?50,"MCR#"

 S ABMP("PDFN")=0

 F  S ABMP("PDFN")=$O(^TMP($J,"ABM-MURPT","MCR",ABMP("PDFN"))) Q:'ABMP("PDFN")  D

 .S ABMP("MDFN")=0

 .F  S ABMP("MDFN")=$O(^TMP($J,"ABM-MURPT","MCR",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN")  D

 ..W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNMCR(ABMP("PDFN"),0)),U,3)

 ;

 ;^TMP($J,"ABM-MURPT","RR",ABMP("PDFN"),ABMP("MDFN"))

 W !!!,"RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD "

 W !?3,"PDFN",?15,"NAME",?50,"RR#"

 S ABMP("PDFN")=0

 F  S ABMP("PDFN")=$O(^TMP($J,"ABM-MURPT","RR",ABMP("PDFN"))) Q:'ABMP("PDFN")  D

 .S ABMP("MDFN")=0

 .F  S ABMP("MDFN")=$O(^TMP($J,"ABM-MURPT","RR",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN")  D

 ..;W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNRRE(ABMP("PDFN"),0)),U,3)  ;abm*2.6*12 HEAT120278

 ..W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUTTRRP($P($G(^AUPNRRE(ABMP("PDFN"),0)),U,3),0)),U)_$P($G(^AUPNRRE(ABMP("PDFN"),0)),U,4)  ;abm*2.6*12 HEAT120278

 ;

 ;start new abm*2.6*11 VMBP#9 RQMT_103

 ;^TMP($J,"ABM-MURPT","VMBP",ABMP("PDFN"),ABMP("MDFN"))

 W !!!,"VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP "

 W !?3,"PDFN",?15,"NAME",?50,"VA#"

 S ABMP("PDFN")=0

 F  S ABMP("PDFN")=$O(^TMP($J,"ABM-MURPT","VAMB",ABMP("PDFN"))) Q:'ABMP("PDFN")  D

 .S ABMP("MDFN")=0

 .F  S ABMP("MDFN")=$O(^TMP($J,"ABM-MURPT","VAMB",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN")  D

 ..W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNVAMB(ABMP("PDFN"),0)),U,6)

 ;end new VMBP#9 RQMT_103

 ;

 ;^TMP($J,"ABM-MURPT","PI",ABMP("PDFN"),ABMP("MDFN"))

 W !!!,"PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE "

 ;W !?3,"PDFN",?15,"NAME",?50,"INS",?62,"MEM#"  ;abm*2.6*15 HEAT188548

 W !?3,"PDFN",?15,"NAME",?50,"MEM#",?71,"INS"  ;abm*2.6*15 HEAT188548

 S ABMP("PDFN")=0

 F  S ABMP("PDFN")=$O(^TMP($J,"ABM-MURPT","PI",ABMP("PDFN"))) Q:'ABMP("PDFN")  D

 .S ABMP("MDFN")=0

 .F  S ABMP("MDFN")=$O(^TMP($J,"ABM-MURPT","PI",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN")  D

 ..;W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U),?62,$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)  ;abm*2.6*15 188495

 ..W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U)

 ..W ?50  ;abm*2.6*15 HEAT188495

 ..I $P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)'="" W $P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U) ;abm*2.6*15 HEAT188495

 ..;I $P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)="" W $P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,8),0)),U,4)  ;abm*2.6*15 HEAT188495  ;abm*2.6*21 IHS/SD/SDR HEAT204790

 ..I $P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)=""&($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,8)'="") W $P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,8),0)),U,4)  ;abm*2.6*21 IHS/SD/SDR HEAT204790

 ..W ?71,$P($G(^AUTNINS($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U),0)),U)_" ("_$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U)_")"  ;abm*2.6*15 HEAT188495 and HEAT188548

 ;

 ;^TMP($J,"ABM-MURPT","NO",ABMP("PDFN"))

 W !!!,"NOT INSURED NOT INSURED NOT INSURED NOT INSURED NOT INSURED NOT INSURED "

 W !?3,"PDFN",?15,"NAME"

 S ABMP("PDFN")=0

 F  S ABMP("PDFN")=$O(^TMP($J,"ABM-MURPT","NO",ABMP("PDFN"))) Q:'ABMP("PDFN")  D

 .W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U)

 Q

 ;

WRTVSTS ;^TMP($J,"ABM-MURPT","ENC",ABMP("VDFN"))

 W !!!,"VISITS VISITS VISITS VISITS VISITS VISITS VISITS VISITS VISITS "

 ;W !?3,"VDFN",?13,"VISIT",?30,"PDFN",?40,"PATIENT"  ;abm*2.6*15 HEAT188548

 W !?3,"VDFN",?13,"VISIT",?34,"PDFN",?44,"PATIENT",?75,"VISIT LOCATION"  ;abm*2.6*15 HEAT188548

 S ABMP("VDFN")=0

 F  S ABMP("VDFN")=$O(^TMP($J,"ABM-MURPT","ENC",ABMP("VDFN"))) Q:'ABMP("VDFN")  D

 .;W !?3,ABMP("VDFN"),?13,$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U),?30,$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5),?40,$P($G(^DPT($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5),0)),U)  ;abm*2.6*15 HEAT188548

 .W !?3,ABMP("VDFN"),?13,$$BDT^ABMDUTL($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U))  ;abm*2.6*15 HEAT188548

 .W ?34,$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5),?44,$P($G(^DPT($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5),0)),U)  ;abm*2.6*15 HEAT188548 formatted visit/admit date/time

 .W ?75,$$GET1^DIQ(4,$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,6),".01","E")  ;abm*2.6*15 HEAT188548 visit location

 Q

ABMMUEL1  ;IHS/SD/SDR - Meaningful Use Report - count patients/eligibility ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**12,15,21**;NOV 12, 2009;Build 379

 +2       ;IHS/SD/SDR - 2.6*15 - HEAT188495 - Fixed policy holder so it will print all the time; defaulted to policy number from policy holder file the

 +3       ;  same way Reg does

 +4       ;IHS/SD/SDR - 2.6*15 - HEAT188548 - Formatted visit/admit date/time for VISIT section

 +5       ;IHS/SD/SDR - 2.6*21 - HEAT204790 - Added code to stop error <SUBSCR>WRTELIG+55^ABMMUEL1.  Occurs when Private Insurance Eligible entry doesn't

 +6       ;   have a coinsiding Policy Holder entry.

 +7       ;

WRTPTS    ;^TMP($J,"ABM-MURPT","PTS",ABMP("PDFN"))

 +1        WRITE !!!,"PATIENTS PATIENTS PATIENTS PATIENTS PATIENTS"

 +2        WRITE !?3,"PDFN",?15,"NAME",?50,"HRN",?60,"DATE INACTIVE"

 +3        SET ABMP("PDFN")=0

 +4        FOR 

               SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","PTS",ABMP("PDFN")))

               IF 'ABMP("PDFN")

                   QUIT 

               Begin DoDot:1

 +5                WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2),?60,$$SDT^ABMDUTL($PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,3))

               End DoDot:1

 +6       ;

 +7       ;^TMP($J,"ABM-MURPT","UNQ",ABMPT)

 +8        WRITE !!!,"UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS"

 +9        WRITE !?3,"PDFN",?15,"NAME",?50,"HRN"

 +10       SET ABMP("PDFN")=0

 +11       FOR 

               SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","UNQ",ABMP("PDFN")))

               IF 'ABMP("PDFN")

                   QUIT 

               Begin DoDot:1

 +12               WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2)

               End DoDot:1

 +13       QUIT 

 +14      ;

WRTELIG   ;

 +1       ;^TMP($J,"ABM-MURPT","MCD",ABMP("PDFN"),ABMP("MDFN"))

 +2        WRITE !!!,"MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID "

 +3        WRITE !?3,"PDFN",?15,"NAME",?50,"MCD#",?81,"PLAN"

 +4        SET ABMP("PDFN")=0

 +5        FOR 

               SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","MCD",ABMP("PDFN")))

               IF 'ABMP("PDFN")

                   QUIT 

               Begin DoDot:1

 +6                SET ABMP("MDFN")=0

 +7                FOR 

                       SET ABMP("MDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","MCD",ABMP("PDFN"),ABMP("MDFN")))

                       IF 'ABMP("MDFN")

                           QUIT 

                       Begin DoDot:2

 +8       ;W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,3),?62,$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,10)  ;abm*2.6*15 HEAT188548

 +9       ;abm*2.6*15 HEAT188548 below line - Expanded mcd# and wrote ins name w/#

 +10                       WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,3)

 +11      ;abm*2.6*15 HEAT188548

                           IF $PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,10)

                               WRITE ?81,$PIECE($GET(^AUTNINS($PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,10),0)),U)_" ("_$PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,10)_")"

                       End DoDot:2

               End DoDot:1

 +12      ;

 +13      ;^TMP($J,"ABM-MURPT","MCR",ABMP("PDFN"),ABMP("MDFN"))

 +14       WRITE !!!,"MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE "

 +15       WRITE !?3,"PDFN",?15,"NAME",?50,"MCR#"

 +16       SET ABMP("PDFN")=0

 +17       FOR 

               SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","MCR",ABMP("PDFN")))

               IF 'ABMP("PDFN")

                   QUIT 

               Begin DoDot:1

 +18               SET ABMP("MDFN")=0

 +19               FOR 

                       SET ABMP("MDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","MCR",ABMP("PDFN"),ABMP("MDFN")))

                       IF 'ABMP("MDFN")

                           QUIT 

                       Begin DoDot:2

 +20                       WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNMCR(ABMP("PDFN"),0)),U,3)

                       End DoDot:2

               End DoDot:1

 +21      ;

 +22      ;^TMP($J,"ABM-MURPT","RR",ABMP("PDFN"),ABMP("MDFN"))

 +23       WRITE !!!,"RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD "

 +24       WRITE !?3,"PDFN",?15,"NAME",?50,"RR#"

 +25       SET ABMP("PDFN")=0

 +26       FOR 

               SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","RR",ABMP("PDFN")))

               IF 'ABMP("PDFN")

                   QUIT 

               Begin DoDot:1

 +27               SET ABMP("MDFN")=0

 +28               FOR 

                       SET ABMP("MDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","RR",ABMP("PDFN"),ABMP("MDFN")))

                       IF 'ABMP("MDFN")

                           QUIT 

                       Begin DoDot:2

 +29      ;W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNRRE(ABMP("PDFN"),0)),U,3)  ;abm*2.6*12 HEAT120278

 +30      ;abm*2.6*12 HEAT120278

                           WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUTTRRP($PIECE($GET(^AUPNRRE(ABMP("PDFN"),0)),U,3),0)),U)_$PIECE($GET(^AUPNRRE(ABMP("PDFN"),0)),U,4)

                       End DoDot:2

               End DoDot:1

 +31      ;

 +32      ;start new abm*2.6*11 VMBP#9 RQMT_103

 +33      ;^TMP($J,"ABM-MURPT","VMBP",ABMP("PDFN"),ABMP("MDFN"))

 +34       WRITE !!!,"VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP "

 +35       WRITE !?3,"PDFN",?15,"NAME",?50,"VA#"

 +36       SET ABMP("PDFN")=0

 +37       FOR 

               SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","VAMB",ABMP("PDFN")))

               IF 'ABMP("PDFN")

                   QUIT 

               Begin DoDot:1

 +38               SET ABMP("MDFN")=0

 +39               FOR 

                       SET ABMP("MDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","VAMB",ABMP("PDFN"),ABMP("MDFN")))

                       IF 'ABMP("MDFN")

                           QUIT 

                       Begin DoDot:2

 +40                       WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNVAMB(ABMP("PDFN"),0)),U,6)

                       End DoDot:2

               End DoDot:1

 +41      ;end new VMBP#9 RQMT_103

 +42      ;

 +43      ;^TMP($J,"ABM-MURPT","PI",ABMP("PDFN"),ABMP("MDFN"))

 +44       WRITE !!!,"PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE "

 +45      ;W !?3,"PDFN",?15,"NAME",?50,"INS",?62,"MEM#"  ;abm*2.6*15 HEAT188548

 +46      ;abm*2.6*15 HEAT188548

           WRITE !?3,"PDFN",?15,"NAME",?50,"MEM#",?71,"INS"

 +47       SET ABMP("PDFN")=0

 +48       FOR 

               SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","PI",ABMP("PDFN")))

               IF 'ABMP("PDFN")

                   QUIT 

               Begin DoDot:1

 +49               SET ABMP("MDFN")=0

 +50               FOR 

                       SET ABMP("MDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","PI",ABMP("PDFN"),ABMP("MDFN")))

                       IF 'ABMP("MDFN")

                           QUIT 

                       Begin DoDot:2

 +51      ;W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U),?62,$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)  ;abm*2.6*15 188495

 +52                       WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U)

 +53      ;abm*2.6*15 HEAT188495

                           WRITE ?50

 +54      ;abm*2.6*15 HEAT188495

                           IF $PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)'=""

                               WRITE $PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)

 +55      ;I $P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)="" W $P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,8),0)),U,4)  ;abm*2.6*15 HEAT188495  ;abm*2.6*21 IHS/SD/SDR HEAT204790

 +56      ;abm*2.6*21 IHS/SD/SDR HEAT204790

                           IF $PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)=""&($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,8)'="")

                               WRITE $PIECE($GET(^AUPN3PPH($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,8),0)),U,4)

 +57      ;abm*2.6*15 HEAT188495 and HEAT188548

                           WRITE ?71,$PIECE($GET(^AUTNINS($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U),0)),U)_" ("_$PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U)_")"

                       End DoDot:2

               End DoDot:1

 +58      ;

 +59      ;^TMP($J,"ABM-MURPT","NO",ABMP("PDFN"))

 +60       WRITE !!!,"NOT INSURED NOT INSURED NOT INSURED NOT INSURED NOT INSURED NOT INSURED "

 +61       WRITE !?3,"PDFN",?15,"NAME"

 +62       SET ABMP("PDFN")=0

 +63       FOR 

               SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","NO",ABMP("PDFN")))

               IF 'ABMP("PDFN")

                   QUIT 

               Begin DoDot:1

 +64               WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U)

               End DoDot:1

 +65       QUIT 

 +66      ;

WRTVSTS   ;^TMP($J,"ABM-MURPT","ENC",ABMP("VDFN"))

 +1        WRITE !!!,"VISITS VISITS VISITS VISITS VISITS VISITS VISITS VISITS VISITS "

 +2       ;W !?3,"VDFN",?13,"VISIT",?30,"PDFN",?40,"PATIENT"  ;abm*2.6*15 HEAT188548

 +3       ;abm*2.6*15 HEAT188548

           WRITE !?3,"VDFN",?13,"VISIT",?34,"PDFN",?44,"PATIENT",?75,"VISIT LOCATION"

 +4        SET ABMP("VDFN")=0

 +5        FOR 

               SET ABMP("VDFN")=$ORDER(^TMP($JOB,"ABM-MURPT","ENC",ABMP("VDFN")))

               IF 'ABMP("VDFN")

                   QUIT 

               Begin DoDot:1

 +6       ;W !?3,ABMP("VDFN"),?13,$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U),?30,$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5),?40,$P($G(^DPT($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5),0)),U)  ;abm*2.6*15 HEAT188548

 +7       ;abm*2.6*15 HEAT188548

                   WRITE !?3,ABMP("VDFN"),?13,$$BDT^ABMDUTL($PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U))

 +8       ;abm*2.6*15 HEAT188548 formatted visit/admit date/time

                   WRITE ?34,$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,5),?44,$PIECE($GET(^DPT($PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,5),0)),U)

 +9       ;abm*2.6*15 HEAT188548 visit location

                   WRITE ?75,$$GET1^DIQ(4,$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,6),".01","E")

               End DoDot:1

 +10       QUIT