- ABMDEMLE ; IHS/ASDST/DMJ - Edit Utility - FOR MULTIPLES ;
- ;;2.6;IHS 3P BILLING SYSTEM;**3,6,8,9,10,11,13,14,15,18,21,23**;NOV 12, 2009;Build 427
- ;
- ; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
- ; IHS/SD/SDR - v2.5 p6 - 7/9/04 - IM14079 and IM14121 - Edited code for TOS
- ; call to not do if 837 format
- ; IHS/SD/SDR - v2.5 p8 - IM12246/IM17548 - Coded new prompts for In-House and Reference Lab CLIAs
- ; IHS/SD/SDR - v2.5 p8 - task 6 - Added code for mileage population on page 3A and message about editing
- ; IHS/SD/SDR - v2.5 p9 - task 1 - Added code for new provider multiple on service lines
- ; IHS/SD/SDR - v2.5 p9 - IM19820 - Fix for <UNDEF>E2+37^ABMDEMLE
- ; IHS/SD/SDR - v2.5 p10 - task order item 1 - Calls added for Chargemaster. Calls supplied by Lori Butcher
- ; IHS/SD/SDR - v2.5 p11 - IM23175 - Added code so G0107 could be entered on the lab page. It needs a CLIA number
- ;
- ; IHS/SD/SDR - v2.6 CSV
- ; IHS/SD/SDR - abm*2.6*6 - 5010 - added code for SV5 segment
- ; IHS/SD/SDR - abm*2.6*6 - 5010 - added code for 2400 DTP Test Date
- ;IHS/SD/SDR - 2.6*13 - exp mode 35. Linked occurrence codes (01 and 11) to page 3 questions (Date First Symptom and Injury Date)
- ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ so output transform will execute for SNOMED/Provider Narrative; also
- ; made change so provider narrative can't be edited if there are SNOMED codes present on claim
- ;IHS/SD/SDR - 2.6*14 - HEAT165301 - Removed link between page 9a and 3 introduced in patch 13
- ;IHS/SD/SDR - 2.6*15 - Added change so they can edit the POA even if there is a SNOMED on the claim
- ;IHS/SD/SDR - 2.6*18 - HEAT240919 - put code back from p14 so user can edit provider narrative
- ;IHS/SD/AML - 2.6*21 - HEAT197195 - Removed dot so POA would be editable on page 5A.
- ;IHS/SD/SDR - 2.6*21 - HEAT233742 - Updated check for CPT Narrative prompt. Wasnt' including Surgical (21) or Ambulance (47) because the range
- ; wasn't inclusive. Changed >21 to >20 and <47 to <48.
- ;IHS/SD/AML 2.6*23 HEAT247169 - Add .19 for NDC to list of editable fields if subfile is 43
- ;
- E1 ; Edit Multiple
- I ABMZ("NUM")=0 W *7,!!,"There are no entries to edit, you must first ADD an entry.",! K DIR S DIR(0)="E" D ^DIR K DIR Q
- S ABMX("EDIT")=""
- I $E(Y,2)>0&($E(Y,2)<(ABMZ("NUM")+1)) S Y=$E(Y,2) G E2
- I ABMZ("NUM")=1 S Y=1 G E2
- K DIR S DIR(0)="NO^1:"_ABMZ("NUM")_":0"
- S DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to Edit",DIR("A")="Sequence Number to EDIT"
- D ^DIR K DIR
- G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(+Y'>0)
- E2 W !!!,"[",+Y,"] ",$P(ABMZ(+Y),U) S ABMX("Y")=+Y
- I $P(ABMZ(+Y),U)="A0",$P($G(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3" W !,"Please edit this value on page 3A1" H 1 K ABMZ("Y"),ABMZ("DR") Q
- ;only execute MOD2^ABMDEMLC if it is not a tran code entry (Chargemaster)
- I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$P(ABMZ(ABMX("Y")),U,2),0),U,17)'["|TC" D
- .I $D(ABMZ("MOD")),$P($G(^ABMDPARM(DUZ(2),1,2)),"^",5) D MOD2^ABMDEMLC S ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG")_"////"_ABMZ("MODFEE")
- ;start new code abm*2.6*9 NARR
- ;I ABMZ("SUB")>21,ABMZ("SUB")<47,ABMZ("SUB")'=41,$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291
- ;I ABMZ("SUB")>21,ABMZ("SUB")<47,ABMZ("SUB")'=41,$G(ABMZIEN)'="",$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291 ;abm*2.6*21 IHS/SD/SDR HEAT233742
- I ABMZ("SUB")>20,ABMZ("SUB")<48,ABMZ("SUB")'=41,$G(ABMZIEN)'="",$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291 ;abm*2.6*21 IHS/SD/SDR HEAT233742
- .Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010" ;only 5010 formats
- .S ABMCNCK=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN,0))
- .I ABMCNCK,$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMCNCK,0)),U,2)="Y" S ABMZ("DR")=ABMZ("DR")_";22"
- ;end new code NARR
- G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- I $D(ABMZ("DIAG")) D DX^ABMDEMLC G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S ABMZ("DR")=ABMZ("DR")_ABMZ("DIAG")_"////"_$G(Y(0))
- I $D(ABMZ("NARR")),$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) D ;abm*2.6*14 HEAT161263 ;abm*2.6*18 IHS/SD/SDR HEAT240919 uncommented line
- .;I $D(ABMZ("NARR")),$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,$P(ABMZ(ABMX("Y")),U,2),1))="",$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) D ;only allow editing of prv narr if SNOMED not present ;abm*2.6*14 HEAT161263
- .;S ABMX("DICB")=$G(^AUTNPOV($P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)),0))_U_$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) ;abm*2.6*14 HEAT161263
- .S IENS=$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) ;abm*2.6*14 HEAT161263
- .S ABMX("DICB")=$$GET1^DIQ(9999999.27,IENS,".01","E") ;abm*2.6*14 HEAT161263
- .D NARR^ABMDEMLC S ABMZ("DR")=ABMZ("DR")_$P(ABMZ("NARR"),U)_+Y
- .;I $G(ABMZ("SUB"))=17&($P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y")&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) S ABMZ("DR")=ABMZ("DR")_";.05//" ;abm*2.6*15
- ;end old abm*2.6*18 IHS/SD/SDR HEAT240919
- I $G(ABMZ("SUB"))=17&($P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y")&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) S ABMZ("DR")=ABMZ("DR")_";.05//" ;abm*2.6*21 IHS/SD/SDR HEAT197195 edit POA
- ; don't do POS if page 5 (Dxs)
- I $G(ABMZ("SUB"))'=17 D
- .D POSA^ABMDEMLC ;abm*2.6*9 NOHEAT ;abm*2.6*10 IHS/SD/AML HEAT76189 - <<REACTIVATED LINE>> REMOVE DUPLICATE POS FIELD FROM 8G, ASKS FOR POS NOW
- .I ABMP("EXP")'=21,(ABMP("EXP")'=22),(ABMP("EXP")'=23) D TOSA^ABMDEMLC ;don't do for 837 formats
- ;I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2)="G0107") D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696
- ;I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2)="G0107")!(ABMZIEN=36415) D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696 ;abm*2.6*8 HEAT40295
- I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($E($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2))="G")!(ABMZIEN=36415) D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696 ;abm*2.6*8 HEAT40295
- .S ABMXMOD=""
- .S DA=$P(ABMZ(ABMX("Y")),U,2)
- .I ABMZ("SUB")=43 F ABMMOD=5,8,9 I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,ABMMOD)=90 S ABMXMOD=1
- .I ABMZ("SUB")=37 F ABMMOD=6,7,8 I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,ABMMOD)=90 S ABMXMOD=1
- .I $G(ABMXMOD)'="" D
- ..S ABMODFLT=$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,14):$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,14),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,23))
- ..S ABMODFLT=$$GET1^DIQ(9002274.35,ABMODFLT,".01","E") ;display ref lab by name, not IEN into ref lab file ;abm*2.6*11 HEAT85498
- ..S ABMZ("DR")=ABMZ("DR")_";.13////@;.14//^S X=ABMODFLT"
- .E S ABMZ("DR")=ABMZ("DR")_";.14////@;.13//"_$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,13):$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,13),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,22))
- I ABMZ("SUB")=37 D
- .Q:+$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMZIEN,0))=0
- .S ABMIIEN=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMZIEN,0))
- .Q:$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,ABMIIEN,0)),U,2)'="Y"
- .S:(ABMP("EXP")=22) ABMZ("DR")=ABMZ("DR")_";W !,!,""Enter LABORATORY Results:"";.19;.21"
- .S:(ABMP("EXP")=32) ABMZ("DR")=ABMZ("DR")_";W !,!,""Enter LABORATORY Results:"";.19;.21;.22" ;abm*2.6*6 5010
- .S:(ABMP("EXP")=21) ABMZ("DR")=ABMZ("DR")_";W !,!,""Value Code 48 or 49 should be present on Page 9C"",!"
- I $D(ABMZ("REVN")) S ABMZ("DR")=ABMZ("DR")_$P(ABMZ("REVN"),"//")
- I $D(ABMZ("CONTRACT")) D CONT^ABMDEMLB
- G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- I $D(ABMZ("OUTLAB")) D LAB^ABMDEMLB
- ;I $D(ABMP(638)),$D(ABMZ("CHRG")) S ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG") ;abm*2.6*3
- I $D(ABMZ("CHRG")) S ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG") ;abm*2.6*3
- I $D(ABMZ("RX")),'$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,$P(ABMZ(ABMX("Y")),U,2),0),U,6) D
- .W !!,"Select PRESCRIPTION NUMBER: "
- .D RX^ABMDEMLB
- .I Y>0 S ABMZ("DR")=ABMZ("DR")_";.06////"_$P(Y(0),U) Q
- .W !,*7,"No match was found in the PRESCRIPTION FILE for this Drug and Patient!",!
- I ABMZ("SUB")=39 D 39^ABMDEML
- I ABMZ("SUB")=43 S ABMZ("DR")=ABMZ("DR")_";.19" ;abm*2.6*23 IHS/SD/AML HEAT247169
- I ABMZ("SUB")=43&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,4)="Y") S ABM("DR")=$S($G(ABM("DR")):ABM("DR")_";11;12;13;14",1:"11;12;13;14") ;abm*2.6*6 5010
- S DA(1)=ABMP("CDFN"),DA=$P(ABMZ(ABMX("Y")),U,2),DIE="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_",",DR=$E(ABMZ("DR"),2,200) D ^DIE K DR
- S DR=".17///M" D ^DIE
- ;start new code abm*2.6*6 5010
- I ABMZ("SUB")=21!(ABMZ("SUB")=27)!(ABMZ("SUB")=35)!(ABMZ("SUB")=37)!(ABMZ("SUB")=39)!(ABMZ("SUB")=43)!(ABMZ("SUB")=47) D
- .I $P($G(^ICPT($P(ABMZ(ABMX("Y")),U),0)),U,3)="" Q ;CPT has no CPT category to check
- .I ($P($G(^DIC(81.1,$P($G(^ICPT(+$P(ABMZ(ABMX("Y")),U),0)),U,3),0)),U)["IMMUNIZATION") S DR="15//" D ^DIE
- ;end new code 5010
- ;I ABMZ("SUB")=51,"^01^11^"[("^"_$P($G(^ABMDCODE($P(ABMZ(ABMX("Y")),U,2),0)),U)_"^") S ABMOIEN=$P(ABMZ(ABMX("Y")),U,2) D OCCURCD^ABMDEML ;abm*2.6*13 exp mode 35 ;abm*2.6*14 HEAT165301
- PROV ;
- S DA=$P(ABMZ(ABMX("Y")),U,2)
- I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",0))>0 D
- .W !
- .S ABMIEN=0
- .F S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN)) Q:+ABMIEN=0 D
- ..W !?5,$P($G(^VA(200,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U),0)),U)
- ..W ?40,$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U,2)="R":"RENDERING",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U,2)="D":"ORDERING",1:"")
- .W !
- K DIC,DR,DIE,DA
- S DA(2)=ABMP("CDFN")
- S DA(1)=$P(ABMZ(ABMX("Y")),U,2)
- S DIC="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
- S DIC(0)="AELMQ"
- S ABMFLNM="9002274.30"_$G(ABMZ("SUB"))
- S DIC("P")=$P($G(^DD(ABMFLNM,.18,0)),U,2)
- Q:DIC("P")=""
- I $G(ABMDPRV)'="" S DIC("B")=ABMDPRV ;abm*2.6*10
- S DIC("DR")=".01;.02//RENDERING"
- I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA(1),"P","C","R",0))>0 S DIC("DR")=".01;.02//ORDERING"
- D ^DIC
- K DIC,DR,DIE,DA
- I +Y>0,(+$P(Y,U,3)=0) D
- .K DIE,DA,DR
- .S DA(2)=ABMP("CDFN")
- .S DA(1)=$P(ABMZ(ABMX("Y")),U,2)
- .S DIE="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
- .S DA=+Y
- .S DR=".01//;.02"
- .D ^DIE
- I $G(ABMP("EXP"))=14!($G(ABMP("EXP"))=22) D
- .S ABMPVCKR=0
- .S ABMPVCKD=0
- .S ABMTYP=""
- .S ABMLN=$P(ABMZ(ABMX("Y")),U,2)
- .F S ABMTYP=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMLN,"P","C",ABMTYP)) Q:ABMTYP="" D
- ..S ABMIEN=0
- ..F S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMLN,"P","C",ABMTYP,ABMIEN)) Q:+ABMIEN=0 D
- ...I ABMTYP="R" S ABMPVCKR=+$G(ABMPVCKR)+1
- ...I ABMTYP="D" S ABMPVCKD=+$G(ABMPVCKD)+1
- .I ABMPVCKR>1!(ABMPVCKD>1) D G PROV
- ..W !!,"YOU HAVE ENTERED TWO ",$S(ABMPVCKR>1:"RENDERING",1:"ORDERING")," PROVIDERS AND ONLY ONE CAN BE PUT ON AN 837P."
- ..K ABMPVCKR,ABMPVCKD,ABMTYP,ABMIEN,ABMLN
- MILEAGE ;
- ;I ((ABMZ("SUB")=47)!(ABMZ("SUB")=43)),("A0888^A0425"[$P(ABMZ(ABMX("Y")),U)) D ;abm*2.6*10 COB billing
- I ((ABMZ("SUB")=47)!(ABMZ("SUB")=43)),("^A0888^A0425^"[("^"_$P(ABMZ(ABMX("Y")),U))_"^") D ;abm*2.6*10 COB billing
- .S DIE="^ABMDCLM(DUZ(2),"
- .S DA=ABMP("CDFN")
- .;start old code abm*2.6*10 HEAT68832
- .;S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"B",ABMX("Y"),0))
- .;I $P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,2)="A0425" S DR=".128////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8)) ;CSV-c
- .;I $P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,2)="A0888" S DR=".129////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9)) ;CSV-c
- .;end old code start new code HEAT68832
- .S ABMIEN=$P(ABMZ(ABMX("Y")),U,2)
- .I $P(ABMZ(ABMX("Y")),U)="A0425" D
- ..;changed below during p10 testing to update page 3A all the time
- ..;S DR=".128////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8)) ;CSV-c ;abm*2.6*10
- ..S DR=".128////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3) ;abm*2.6*10
- .I $P(ABMZ(ABMX("Y")),U)="A0888" D
- ..;changed below during p10 testing to update page 3A all the time
- ..;S DR=".129////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9)) ;CSV-c ;abm*2.6*10
- ..S DR=".129////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3) ;abm*2.6*10
- .;end new code HEAT68832
- .D ^DIE
- ;
- XIT K ABMX
- Q
- ABMDEMLE ; IHS/ASDST/DMJ - Edit Utility - FOR MULTIPLES ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**3,6,8,9,10,11,13,14,15,18,21,23**;NOV 12, 2009;Build 427
- +2 ;
- +3 ; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
- +4 ; IHS/SD/SDR - v2.5 p6 - 7/9/04 - IM14079 and IM14121 - Edited code for TOS
- +5 ; call to not do if 837 format
- +6 ; IHS/SD/SDR - v2.5 p8 - IM12246/IM17548 - Coded new prompts for In-House and Reference Lab CLIAs
- +7 ; IHS/SD/SDR - v2.5 p8 - task 6 - Added code for mileage population on page 3A and message about editing
- +8 ; IHS/SD/SDR - v2.5 p9 - task 1 - Added code for new provider multiple on service lines
- +9 ; IHS/SD/SDR - v2.5 p9 - IM19820 - Fix for <UNDEF>E2+37^ABMDEMLE
- +10 ; IHS/SD/SDR - v2.5 p10 - task order item 1 - Calls added for Chargemaster. Calls supplied by Lori Butcher
- +11 ; IHS/SD/SDR - v2.5 p11 - IM23175 - Added code so G0107 could be entered on the lab page. It needs a CLIA number
- +12 ;
- +13 ; IHS/SD/SDR - v2.6 CSV
- +14 ; IHS/SD/SDR - abm*2.6*6 - 5010 - added code for SV5 segment
- +15 ; IHS/SD/SDR - abm*2.6*6 - 5010 - added code for 2400 DTP Test Date
- +16 ;IHS/SD/SDR - 2.6*13 - exp mode 35. Linked occurrence codes (01 and 11) to page 3 questions (Date First Symptom and Injury Date)
- +17 ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ so output transform will execute for SNOMED/Provider Narrative; also
- +18 ; made change so provider narrative can't be edited if there are SNOMED codes present on claim
- +19 ;IHS/SD/SDR - 2.6*14 - HEAT165301 - Removed link between page 9a and 3 introduced in patch 13
- +20 ;IHS/SD/SDR - 2.6*15 - Added change so they can edit the POA even if there is a SNOMED on the claim
- +21 ;IHS/SD/SDR - 2.6*18 - HEAT240919 - put code back from p14 so user can edit provider narrative
- +22 ;IHS/SD/AML - 2.6*21 - HEAT197195 - Removed dot so POA would be editable on page 5A.
- +23 ;IHS/SD/SDR - 2.6*21 - HEAT233742 - Updated check for CPT Narrative prompt. Wasnt' including Surgical (21) or Ambulance (47) because the range
- +24 ; wasn't inclusive. Changed >21 to >20 and <47 to <48.
- +25 ;IHS/SD/AML 2.6*23 HEAT247169 - Add .19 for NDC to list of editable fields if subfile is 43
- +26 ;
- E1 ; Edit Multiple
- +1 IF ABMZ("NUM")=0
- WRITE *7,!!,"There are no entries to edit, you must first ADD an entry.",!
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +2 SET ABMX("EDIT")=""
- +3 IF $EXTRACT(Y,2)>0&($EXTRACT(Y,2)<(ABMZ("NUM")+1))
- SET Y=$EXTRACT(Y,2)
- GOTO E2
- +4 IF ABMZ("NUM")=1
- SET Y=1
- GOTO E2
- +5 KILL DIR
- SET DIR(0)="NO^1:"_ABMZ("NUM")_":0"
- +6 SET DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to Edit"
- SET DIR("A")="Sequence Number to EDIT"
- +7 DO ^DIR
- KILL DIR
- +8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(+Y'>0)
- GOTO XIT
- E2 WRITE !!!,"[",+Y,"] ",$PIECE(ABMZ(+Y),U)
- SET ABMX("Y")=+Y
- +1 IF $PIECE(ABMZ(+Y),U)="A0"
- IF $PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3"
- WRITE !,"Please edit this value on page 3A1"
- HANG 1
- KILL ABMZ("Y"),ABMZ("DR")
- QUIT
- +2 ;only execute MOD2^ABMDEMLC if it is not a tran code entry (Chargemaster)
- +3 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$PIECE(ABMZ(ABMX("Y")),U,2),0),U,17)'["|TC"
- Begin DoDot:1
- +4 IF $DATA(ABMZ("MOD"))
- IF $PIECE($GET(^ABMDPARM(DUZ(2),1,2)),"^",5)
- DO MOD2^ABMDEMLC
- SET ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG")_"////"_ABMZ("MODFEE")
- End DoDot:1
- +5 ;start new code abm*2.6*9 NARR
- +6 ;I ABMZ("SUB")>21,ABMZ("SUB")<47,ABMZ("SUB")'=41,$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291
- +7 ;I ABMZ("SUB")>21,ABMZ("SUB")<47,ABMZ("SUB")'=41,$G(ABMZIEN)'="",$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291 ;abm*2.6*21 IHS/SD/SDR HEAT233742
- +8 ;abm*2.6*10 HEAT74291 ;abm*2.6*21 IHS/SD/SDR HEAT233742
- IF ABMZ("SUB")>20
- IF ABMZ("SUB")<48
- IF ABMZ("SUB")'=41
- IF $GET(ABMZIEN)'=""
- IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN))
- Begin DoDot:1
- +9 ;only 5010 formats
- IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
- QUIT
- +10 SET ABMCNCK=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN,0))
- +11 IF ABMCNCK
- IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMCNCK,0)),U,2)="Y"
- SET ABMZ("DR")=ABMZ("DR")_";22"
- End DoDot:1
- +12 ;end new code NARR
- +13 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO XIT
- +14 IF $DATA(ABMZ("DIAG"))
- DO DX^ABMDEMLC
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO XIT
- SET ABMZ("DR")=ABMZ("DR")_ABMZ("DIAG")_"////"_$GET(Y(0))
- +15 ;abm*2.6*14 HEAT161263 ;abm*2.6*18 IHS/SD/SDR HEAT240919 uncommented line
- IF $DATA(ABMZ("NARR"))
- IF $PIECE(ABMZ(ABMX("Y")),U,$PIECE(ABMZ("NARR"),U,3))
- Begin DoDot:1
- +16 ;I $D(ABMZ("NARR")),$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,$P(ABMZ(ABMX("Y")),U,2),1))="",$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) D ;only allow editing of prv narr if SNOMED not present ;abm*2.6*14 HEAT161263
- +17 ;S ABMX("DICB")=$G(^AUTNPOV($P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)),0))_U_$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) ;abm*2.6*14 HEAT161263
- +18 ;abm*2.6*14 HEAT161263
- SET IENS=$PIECE(ABMZ(ABMX("Y")),U,$PIECE(ABMZ("NARR"),U,3))
- +19 ;abm*2.6*14 HEAT161263
- SET ABMX("DICB")=$$GET1^DIQ(9999999.27,IENS,".01","E")
- +20 DO NARR^ABMDEMLC
- SET ABMZ("DR")=ABMZ("DR")_$PIECE(ABMZ("NARR"),U)_+Y
- +21 ;I $G(ABMZ("SUB"))=17&($P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y")&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) S ABMZ("DR")=ABMZ("DR")_";.05//" ;abm*2.6*15
- End DoDot:1
- +22 ;end old abm*2.6*18 IHS/SD/SDR HEAT240919
- +23 ;abm*2.6*21 IHS/SD/SDR HEAT197195 edit POA
- IF $GET(ABMZ("SUB"))=17&($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y")&(($EXTRACT(ABMP("BTYP"),1,2)=11)!($EXTRACT(ABMP("BTYP"),1,2)="12"))
- SET ABMZ("DR")=ABMZ("DR")_";.05//"
- +24 ; don't do POS if page 5 (Dxs)
- +25 IF $GET(ABMZ("SUB"))'=17
- Begin DoDot:1
- +26 ;abm*2.6*9 NOHEAT ;abm*2.6*10 IHS/SD/AML HEAT76189 - <<REACTIVATED LINE>> REMOVE DUPLICATE POS FIELD FROM 8G, ASKS FOR POS NOW
- DO POSA^ABMDEMLC
- +27 ;don't do for 837 formats
- IF ABMP("EXP")'=21
- IF (ABMP("EXP")'=22)
- IF (ABMP("EXP")'=23)
- DO TOSA^ABMDEMLC
- End DoDot:1
- +28 ;I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2)="G0107") D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696
- +29 ;I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2)="G0107")!(ABMZIEN=36415) D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696 ;abm*2.6*8 HEAT40295
- +30 ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696 ;abm*2.6*8 HEAT40295
- IF $GET(ABMZIEN)'=""
- IF ((ABMZIEN>79999)&(ABMZIEN<90000))!($EXTRACT($PIECE($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2))="G")!(ABMZIEN=36415)
- Begin DoDot:1
- +31 SET ABMXMOD=""
- +32 SET DA=$PIECE(ABMZ(ABMX("Y")),U,2)
- +33 IF ABMZ("SUB")=43
- FOR ABMMOD=5,8,9
- IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,ABMMOD)=90
- SET ABMXMOD=1
- +34 IF ABMZ("SUB")=37
- FOR ABMMOD=6,7,8
- IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,ABMMOD)=90
- SET ABMXMOD=1
- +35 IF $GET(ABMXMOD)'=""
- Begin DoDot:2
- +36 SET ABMODFLT=$SELECT($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,14):$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,14),1:$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,23))
- +37 ;display ref lab by name, not IEN into ref lab file ;abm*2.6*11 HEAT85498
- SET ABMODFLT=$$GET1^DIQ(9002274.35,ABMODFLT,".01","E")
- +38 SET ABMZ("DR")=ABMZ("DR")_";.13////@;.14//^S X=ABMODFLT"
- End DoDot:2
- +39 IF '$TEST
- SET ABMZ("DR")=ABMZ("DR")_";.14////@;.13//"_$SELECT($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,13):$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,13),1:$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,22))
- End DoDot:1
- +40 IF ABMZ("SUB")=37
- Begin DoDot:1
- +41 IF +$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMZIEN,0))=0
- QUIT
- +42 SET ABMIIEN=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMZIEN,0))
- +43 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,ABMIIEN,0)),U,2)'="Y"
- QUIT
- +44 IF (ABMP("EXP")=22)
- SET ABMZ("DR")=ABMZ("DR")_";W !,!,""Enter LABORATORY Results:"";.19;.21"
- +45 ;abm*2.6*6 5010
- IF (ABMP("EXP")=32)
- SET ABMZ("DR")=ABMZ("DR")_";W !,!,""Enter LABORATORY Results:"";.19;.21;.22"
- +46 IF (ABMP("EXP")=21)
- SET ABMZ("DR")=ABMZ("DR")_";W !,!,""Value Code 48 or 49 should be present on Page 9C"",!"
- End DoDot:1
- +47 IF $DATA(ABMZ("REVN"))
- SET ABMZ("DR")=ABMZ("DR")_$PIECE(ABMZ("REVN"),"//")
- +48 IF $DATA(ABMZ("CONTRACT"))
- DO CONT^ABMDEMLB
- +49 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO XIT
- +50 IF $DATA(ABMZ("OUTLAB"))
- DO LAB^ABMDEMLB
- +51 ;I $D(ABMP(638)),$D(ABMZ("CHRG")) S ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG") ;abm*2.6*3
- +52 ;abm*2.6*3
- IF $DATA(ABMZ("CHRG"))
- SET ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG")
- +53 IF $DATA(ABMZ("RX"))
- IF '$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,$PIECE(ABMZ(ABMX("Y")),U,2),0),U,6)
- Begin DoDot:1
- +54 WRITE !!,"Select PRESCRIPTION NUMBER: "
- +55 DO RX^ABMDEMLB
- +56 IF Y>0
- SET ABMZ("DR")=ABMZ("DR")_";.06////"_$PIECE(Y(0),U)
- QUIT
- +57 WRITE !,*7,"No match was found in the PRESCRIPTION FILE for this Drug and Patient!",!
- End DoDot:1
- +58 IF ABMZ("SUB")=39
- DO 39^ABMDEML
- +59 ;abm*2.6*23 IHS/SD/AML HEAT247169
- IF ABMZ("SUB")=43
- SET ABMZ("DR")=ABMZ("DR")_";.19"
- +60 ;abm*2.6*6 5010
- IF ABMZ("SUB")=43&($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,4)="Y")
- SET ABM("DR")=$SELECT($GET(ABM("DR")):ABM("DR")_";11;12;13;14",1:"11;12;13;14")
- +61 SET DA(1)=ABMP("CDFN")
- SET DA=$PIECE(ABMZ(ABMX("Y")),U,2)
- SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
- SET DR=$EXTRACT(ABMZ("DR"),2,200)
- DO ^DIE
- KILL DR
- +62 SET DR=".17///M"
- DO ^DIE
- +63 ;start new code abm*2.6*6 5010
- +64 IF ABMZ("SUB")=21!(ABMZ("SUB")=27)!(ABMZ("SUB")=35)!(ABMZ("SUB")=37)!(ABMZ("SUB")=39)!(ABMZ("SUB")=43)!(ABMZ("SUB")=47)
- Begin DoDot:1
- +65 ;CPT has no CPT category to check
- IF $PIECE($GET(^ICPT($PIECE(ABMZ(ABMX("Y")),U),0)),U,3)=""
- QUIT
- +66 IF ($PIECE($GET(^DIC(81.1,$PIECE($GET(^ICPT(+$PIECE(ABMZ(ABMX("Y")),U),0)),U,3),0)),U)["IMMUNIZATION")
- SET DR="15//"
- DO ^DIE
- End DoDot:1
- +67 ;end new code 5010
- +68 ;I ABMZ("SUB")=51,"^01^11^"[("^"_$P($G(^ABMDCODE($P(ABMZ(ABMX("Y")),U,2),0)),U)_"^") S ABMOIEN=$P(ABMZ(ABMX("Y")),U,2) D OCCURCD^ABMDEML ;abm*2.6*13 exp mode 35 ;abm*2.6*14 HEAT165301
- PROV ;
- +1 SET DA=$PIECE(ABMZ(ABMX("Y")),U,2)
- +2 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",0))>0
- Begin DoDot:1
- +3 WRITE !
- +4 SET ABMIEN=0
- +5 FOR
- SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN))
- IF +ABMIEN=0
- QUIT
- Begin DoDot:2
- +6 WRITE !?5,$PIECE($GET(^VA(200,$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U),0)),U)
- +7 WRITE ?40,$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U,2)="R":"RENDERING",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U,2)="D":"ORDERING",1:"")
- End DoDot:2
- +8 WRITE !
- End DoDot:1
- +9 KILL DIC,DR,DIE,DA
- +10 SET DA(2)=ABMP("CDFN")
- +11 SET DA(1)=$PIECE(ABMZ(ABMX("Y")),U,2)
- +12 SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
- +13 SET DIC(0)="AELMQ"
- +14 SET ABMFLNM="9002274.30"_$GET(ABMZ("SUB"))
- +15 SET DIC("P")=$PIECE($GET(^DD(ABMFLNM,.18,0)),U,2)
- +16 IF DIC("P")=""
- QUIT
- +17 ;abm*2.6*10
- IF $GET(ABMDPRV)'=""
- SET DIC("B")=ABMDPRV
- +18 SET DIC("DR")=".01;.02//RENDERING"
- +19 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA(1),"P","C","R",0))>0
- SET DIC("DR")=".01;.02//ORDERING"
- +20 DO ^DIC
- +21 KILL DIC,DR,DIE,DA
- +22 IF +Y>0
- IF (+$PIECE(Y,U,3)=0)
- Begin DoDot:1
- +23 KILL DIE,DA,DR
- +24 SET DA(2)=ABMP("CDFN")
- +25 SET DA(1)=$PIECE(ABMZ(ABMX("Y")),U,2)
- +26 SET DIE="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
- +27 SET DA=+Y
- +28 SET DR=".01//;.02"
- +29 DO ^DIE
- End DoDot:1
- +30 IF $GET(ABMP("EXP"))=14!($GET(ABMP("EXP"))=22)
- Begin DoDot:1
- +31 SET ABMPVCKR=0
- +32 SET ABMPVCKD=0
- +33 SET ABMTYP=""
- +34 SET ABMLN=$PIECE(ABMZ(ABMX("Y")),U,2)
- +35 FOR
- SET ABMTYP=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMLN,"P","C",ABMTYP))
- IF ABMTYP=""
- QUIT
- Begin DoDot:2
- +36 SET ABMIEN=0
- +37 FOR
- SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMLN,"P","C",ABMTYP,ABMIEN))
- IF +ABMIEN=0
- QUIT
- Begin DoDot:3
- +38 IF ABMTYP="R"
- SET ABMPVCKR=+$GET(ABMPVCKR)+1
- +39 IF ABMTYP="D"
- SET ABMPVCKD=+$GET(ABMPVCKD)+1
- End DoDot:3
- End DoDot:2
- +40 IF ABMPVCKR>1!(ABMPVCKD>1)
- Begin DoDot:2
- +41 WRITE !!,"YOU HAVE ENTERED TWO ",$SELECT(ABMPVCKR>1:"RENDERING",1:"ORDERING")," PROVIDERS AND ONLY ONE CAN BE PUT ON AN 837P."
- +42 KILL ABMPVCKR,ABMPVCKD,ABMTYP,ABMIEN,ABMLN
- End DoDot:2
- GOTO PROV
- End DoDot:1
- MILEAGE ;
- +1 ;I ((ABMZ("SUB")=47)!(ABMZ("SUB")=43)),("A0888^A0425"[$P(ABMZ(ABMX("Y")),U)) D ;abm*2.6*10 COB billing
- +2 ;abm*2.6*10 COB billing
- IF ((ABMZ("SUB")=47)!(ABMZ("SUB")=43))
- IF ("^A0888^A0425^"[("^"_$PIECE(ABMZ(ABMX("Y")),U))_"^")
- Begin DoDot:1
- +3 SET DIE="^ABMDCLM(DUZ(2),"
- +4 SET DA=ABMP("CDFN")
- +5 ;start old code abm*2.6*10 HEAT68832
- +6 ;S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"B",ABMX("Y"),0))
- +7 ;I $P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,2)="A0425" S DR=".128////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8)) ;CSV-c
- +8 ;I $P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,2)="A0888" S DR=".129////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9)) ;CSV-c
- +9 ;end old code start new code HEAT68832
- +10 SET ABMIEN=$PIECE(ABMZ(ABMX("Y")),U,2)
- +11 IF $PIECE(ABMZ(ABMX("Y")),U)="A0425"
- Begin DoDot:2
- +12 ;changed below during p10 testing to update page 3A all the time
- +13 ;S DR=".128////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8)) ;CSV-c ;abm*2.6*10
- +14 ;abm*2.6*10
- SET DR=".128////"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3)
- End DoDot:2
- +15 IF $PIECE(ABMZ(ABMX("Y")),U)="A0888"
- Begin DoDot:2
- +16 ;changed below during p10 testing to update page 3A all the time
- +17 ;S DR=".129////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9)) ;CSV-c ;abm*2.6*10
- +18 ;abm*2.6*10
- SET DR=".129////"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3)
- End DoDot:2
- +19 ;end new code HEAT68832
- +20 DO ^DIE
- End DoDot:1
- +21 ;
- XIT KILL ABMX
- +1 QUIT
