Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDEMLA

ABMDEMLA.m

Go to the documentation of this file. 
  1. ABMDEMLA ; IHS/ASDST/DMJ - Edit Utility - FOR MULTIPLES PART 2 ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**4,9,11,14,21**;NOV 12, 2009;Build 379
  1.  ;
  1.  ; IHS/ASDS/LSL - 04/26/01 - V2.4 Patch 9 - NOIS BXX-0401-150085
  1.  ;     Allow resequencing of DX when list contains more than 30 characters.
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*14 - ICD10 002F - Added code to populate new .06 field, ICD Indicator
  1.  ;IHS/SD/SDR - 2.6*14 - HEAT163742 - Fixed issue with sequencing when 'garbage' is entered
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT197150 - If there were 10+ DXs on a claim it wouldn't sequence them.  It was expecting
  1.  ;  there to only be 1-digit sequence numbers in the validation check of the data entered.
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT220530 - Made change to longer list of billing sequence can be entered; changed from 40 to 55
  1.  ;  chars in DIR call.
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. S1 ; Sequence Multiple
  1.  K DIR S DIR("B")=1 F ABMX=2:1:ABMZ("NUM") Q:ABMX>ABMZ("NUM")  S DIR("B")=DIR("B")_","_ABMX
  1.  I DIR("B")=1 G XIT
  1.  ;S DIR(0)="FO^1:40"  ;abm*2.6*21 IHS/SD/SDR HEAT220530
  1.  S DIR(0)="FO^1:55"  ;abm*2.6*21 IHS/SD/SDR HEAT220530
  1.  S DIR("A")="Enter the desired billing sequence"
  1.  S DIR("?")="Enter the billing sequence, separated by commas"
  1.  S DIR("A",1)=" "
  1.  S DIR("A",2)="          If you need to change the current billing order then"
  1.  S DIR("A",3)="          enter the sequence numbers above in the desired order"
  1.  S DIR("A",4)="          separated by commas."
  1.  S DIR("A",5)=" "
  1.  S DIR("A",6)="          NOTE: If the billing sequence is different from that noted"
  1.  ;S DIR("A",7)="                in the file then a Physcian's Attestation is required!"  ;abm*2.6*4 NOHEAT
  1.  S DIR("A",7)="                in the file then a Physician's Attestation is required!"  ;abm*2.6*4 NOHEAT
  1.  S DIR("A",8)=" "
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)!$D(DIROUT)
  1. S2 ;
  1.  ;K ABMX F ABMX=1:1 S ABMX("Y")=$P(Y,",",ABMX) Q:ABMX("Y")=""  Q:+ABMX("Y")'>0!(ABMX("Y")'<(ABMZ("NUM")+1))!$D(ABMX(ABMX("Y")))  S ABMX(ABMX("Y"))=ABMX  ;abm*2.6*11 HEAT116046
  1.  ;start new abm*2.6*14 HEAT163742
  1.  S ABMCHKFG=0
  1.  F ABMX=1:1:$L(Y) D
  1.  .S ABMXTEST=$E(Y,ABMX)
  1.  .;I '((ABMXTEST=",")!(($A(ABMXTEST)>48)&($A(ABMXTEST)<58))) S ABMCHKFG=1  ;abm*2.6*21 IHS/SD/SDR HEAT197150
  1.  .I '((ABMXTEST=",")!(+ABMXTEST=ABMXTEST)) S ABMCHKFG=1  ;abm*2.6*21 IHS/SD/SDR HEAT197150
  1.  I ABMCHKFG=1 D  G S1
  1.  .W !!,"Non-numeric data entered during sequencing.  Separate using commas."
  1.  .W !,"Please try again"
  1.  ;end new NOHEAT7
  1.  K ABMX F ABMX=1:1 S ABMX("Y")=+$P(Y,",",ABMX) Q:ABMX("Y")=""  Q:+ABMX("Y")'>0!(ABMX("Y")'<(ABMZ("NUM")+1))!$D(ABMX(ABMX("Y")))  S ABMX(ABMX("Y"))=ABMX  ;abm*2.6*11 HEAT116046
  1.  I (ABMZ("NUM")+1)'=ABMX W *7,!!,"ERROR: Invalid input, to re-sequence all sequence numbers must be specified",!,"       and separated with commas.",! Q
  1.  ;S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_",",DIC(0)="LE"  ;abm*2.6*14 ICD10 002F
  1.  ;K ^ABMDCLM(DUZ(2),DA(1),ABMZ("SUB")) S ^ABMDCLM(DUZ(2),DA(1),ABMZ("SUB"),0)="^9002274.30"_ABMZ("SUB")_"P^^"  ;abm*2.6*14 ICD10 002F
  1.  ;start new code abm*2.6*14 ICD10 002F
  1.  S ABMTMP=0
  1.  F  S ABMTMP=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"C",ABMTMP)) Q:'ABMTMP  D
  1.  .S ABMTMP2=0
  1.  .F  S ABMTMP2=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"C",ABMTMP,ABMTMP2)) Q:'ABMTMP2  D
  1.  ..S DA(1)=ABMP("CDFN")
  1.  ..S DIK="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
  1.  ..S DA=ABMTMP2
  1.  ..D ^DIK
  1.  K ABMTMP,ABMTMP2
  1.  D ^XBFMK
  1.  ;end new code ICD10 002F
  1.  ;F ABMX=1:1:ABMZ("NUM") S X=$P(ABMZ(ABMX),U,3),DIC("DR")=".02////"_ABMX(ABMX)_";.05////"_$P($G(ABMZ(ABMX)),U,5) S:ABMZ("X")="DINUM" DINUM=X D DR  ;abm*2.6*9 HEAT63840
  1.  ;F ABMX=1:1:ABMZ("NUM") S X=$P(ABMZ(ABMX),U,3),DIC("DR")=".02////"_ABMX(ABMX)_";.03////"_$P($G(ABMZ(ABMX)),U,3)_";.04////"_$P($G(ABMZ(ABMX)),U,5)_";.05////"_$P($G(ABMZ(ABMX)),U,6) S:ABMZ("X")="DINUM" DINUM=X D DR  ;abm*2.6*9 HEAT63840  ;abm*2.6*14 ICD10 002F
  1.  ;start new code abm*2.6*14 ICD10 002F
  1.  S DA(1)=ABMP("CDFN")
  1.  S DIC="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
  1.  S DIC(0)="LE"
  1.  F ABMX=1:1:ABMZ("NUM") D
  1.  .S X=$P(ABMZ(ABMX),U,3)
  1.  .S DIC("DR")=".02////"_ABMX(ABMX)
  1.  .S DIC("DR")=DIC("DR")_";.03////"_$P($G(ABMZ(ABMX)),U,3)_";.04////"_$P($G(ABMZ(ABMX)),U,5)_";.05////"_$P($G(ABMZ(ABMX)),U,6)_";.06////"_$P($G(ABMZ(ABMX)),U,7)
  1.  .S:ABMZ("X")="DINUM" DINUM=X
  1.  .D DR
  1.  ;end new code ICD10 002F
  1.  Q
  1.  ;
  1. RES(ABMULT) ;EP - RESET PRIORITIES - X=MULTIPLE
  1.  N DIE,DA
  1.  S DA(1)=ABMP("CDFN")
  1.  S DIE="^ABMDCLM(DUZ(2),DA(1),ABMULT,"
  1.  S ABMI=0,ABMCNT=0
  1.  F  S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMULT,"C",ABMI)) Q:'ABMI  D
  1.  .S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMULT,"C",ABMI,0))
  1.  .S ABMCNT=ABMCNT+1
  1.  .;S DR=".02///"_ABMCNT  ;abm*2.6*14 ICD10 002F
  1.  .S DR=".02////"_ABMCNT  ;abm*2.6*14 ICD10 002F
  1.  .D ^DIE
  1.  K ABMI,ABMULT,ABMCNT
  1.  Q
  1.  ;
  1. DR ;DR LINE TAG
  1.  S:$P(ABMZ(ABMX),U,4)]"" DIC("DR")=DIC("DR")_";.03////"_$P(ABMZ(ABMX),U,4)
  1.  S:$P(ABMZ(ABMX),U,5)]"" DIC("DR")=DIC("DR")_";.04////"_$P(ABMZ(ABMX),U,5)
  1.  S:$P(ABMZ(ABMX),U,6)]"" DIC("DR")=DIC("DR")_";.05////"_$P(ABMZ(ABMX),U,6)
  1.  S:$P(ABMZ(ABMX),U,7)]"" DIC("DR")=DIC("DR")_";.06////"_$P(ABMZ(ABMX),U,7)
  1.  S:$P(ABMZ(ABMX),U,8)]"" DIC("DR")=DIC("DR")_";.07////"_$P(ABMZ(ABMX),U,8)
  1.  S:$P(ABMZ(ABMX),U,9)]"" DIC("DR")=DIC("DR")_";.08////"_$P(ABMZ(ABMX),U,9)
  1.  S:$P(ABMZ(ABMX),U,10)]"" DIC("DR")=DIC("DR")_";.09////"_$P(ABMZ(ABMX),U,10)
  1.  K DD,DO D FILE^DICN
  1.  Q
  1.  ;
  1. AN ;EP for Entering Anesthesia info
  1.  Q
  1.  ;
  1. XIT K ABMX
  1.  Q