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

ABMDF3.m

Go to the documentation of this file. 
  1. ABMDF3 ; IHS/ASDST/DMJ - Set HCFA-1500 Print Array ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;TMD;
  1.  ;
  1.  ; IHS/DSD/LSL 03/21/98  - Modified logic in 
  1.  ;             tab ABMU to kill ABMU array if no more
  1.  ;             numeric subscipts.  solve problem of 
  1.  ;             HCFA print same page w/no procedures
  1.  ;             continuous   (Nois: HQW-0398-100121)
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p9 - IM16876
  1.  ;    (cont) removed from block 28/30 if payment
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p12 - IM24880
  1.  ;    Correction to number of line items printing on
  1.  ;    each page (wasn't printing 6 on each)
  1.  ;
  1.  K ABMP,ABMF
  1.  S ABMP("EXP")=3
  1.  D TXST^ABMDFUTL
  1.  ;
  1. BDFN ;
  1.  S ABMY("N")=0
  1.  F  S ABMY("N")=$O(ABMY(ABMY("N"))) Q:'ABMY("N")  D
  1.  .S ABMP("BDFN")=""
  1.  .F  S ABMP("BDFN")=$O(ABMY(ABMY("N"),ABMP("BDFN"))) Q:'ABMP("BDFN")  D
  1.  ..Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
  1.  ..D ENT
  1.  ..S DIE="^ABMDBILL(DUZ(2),"
  1.  ..S DA=ABMP("BDFN")
  1.  ..S DR=".04////B;.16////A;.17////"_ABMP("XMIT")
  1.  ..D ^ABMDDIE
  1.  ..Q:$D(ABM("DIE-FAIL"))
  1.  ..K ^ABMDBILL(DUZ(2),"AS",+^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"A",ABMP("BDFN")),^ABMDBILL(DUZ(2),"AC","A",ABMP("BDFN"))
  1.  D TXUPDT^ABMDFUTL
  1.  ;
  1. XIT ;
  1.  K ABM,ABMV,ABMF,ABMS,ABMR
  1.  Q
  1.  ;
  1. HCFA ;
  1.  D EMG^ABMDF3E
  1.  F ABMS("I")=36:1:47 K ABMF(ABMS("I"))
  1.  F ABMS("I")=37:2:47 D  Q:$G(ABM("QUIT"))
  1.  .I $D(ABMR) D
  1.  ..S ABMS=0
  1.  ..F  S ABMS=$O(ABMS(ABMS)) Q:+ABMS=0  D
  1.  ...S ABMLN=2
  1.  ...D PROC^ABMDF3E
  1.  ...S ABMLN=ABMLN+1
  1.  ..S ABMLN=0,ABMPRT=0
  1.  .F ABMS("I")=37:1:47 D  Q:$G(ABM("QUIT"))
  1.  ..S ABMLN=$O(ABMR(ABMLN))
  1.  ..I 'ABMLN S ABM("QUIT")=1 Q
  1.  ..S ABMPRT=0
  1.  ..I (($O(ABMR(ABMLN,9),-1))+(ABMS("I")))>49 Q
  1.  ..S ABMLCNT=0
  1.  ..F  S ABMPRT=$O(ABMR(ABMLN,ABMPRT)) Q:+ABMPRT=0  D
  1.  ...I +$O(ABMR(ABMLN,ABMPRT))'=0,($G(ABMF(ABMS("I")-1))=""),(ABMS("I")#2=1),ABMS("I")=37 S ABMS("I")=ABMS("I")-1
  1.  ...M ABMF(ABMS("I"))=ABMR(ABMLN,ABMPRT)
  1.  ...S ABMLCNT=ABMLCNT+1
  1.  ...S ABMS("I")=ABMS("I")+1
  1.  ...K ABMR(ABMLN,ABMPRT)
  1.  ..K ABMR(ABMLN)
  1.  I (ABMS("I")>=47),(+$O(ABMR(ABMS))'=0)!(ABMS("I")>=47),($O(ABMR(ABMS))="MORE") D ^ABMDF3X G HCFA
  1.  S $P(ABMF(49),U,7)=$P(ABMR("TOT"),U)
  1.  S $P(ABMF(49),U,8)=$P(ABMR("TOT"),U,2)
  1.  S $P(ABMF(49),U,9)=$P(ABMR("TOT"),U,3)
  1.  K ABMR("MORE")
  1.  D ^ABMDF3X
  1.  Q
  1.  ;
  1. ENT ;EP for setting up export array
  1.  K ABMP("INS"),ABMP("CDFN")
  1.  D ^ABMDF3A,^ABMDF3B,^ABMDF3C,^ABMDF3D
  1.  I +$O(ABMR("")) S ABMR("MORE")="",ABMP("MORE")=""
  1.  ;payment so flag to write (cont.)
  1.  K ABMTEST,ABMTEST1
  1.  S ABMTEST=$P($G(ABMP("B0")),U)
  1.  S ABMTEST1=$O(^ABMDBILL(DUZ(2),"B",ABMTEST),-1)
  1.  I ($E(ABMTEST,1,$L(ABMTEST)-1))=($E(ABMTEST1,1,$L(ABMTEST1)-1)) D
  1.  .I $D(^ABMDBILL(DUZ(2),$O(^ABMDBILL(DUZ(2),"B",ABMTEST1,"")),3,0)) S ABMP("PTOT")=1
  1.  K ABM("LTOT")
  1.  I $$MPP^ABMUTLP(ABMP("BDFN")) D
  1.  .S $P(ABMF(11),"^",2)="NONE"
  1.  .S $P(ABMF(13),"^",4,6)=""
  1.  .S $P(ABMF(15),"^",7)=""
  1.  .S $P(ABMF(17),"^",4)=""
  1.  D ^ABMDF3X
  1.  I +$O(ABMR("")) S ABMS=0 D HCFA
  1.  Q
  1.  ;
  1. ABMU ; EP
  1.  ; Long Description
  1.  N I,J
  1.  S I=0
  1.  F J=1,2 S I=$O(ABMU(I)) Q:'+I  D
  1.  .S:J=1 ABMF(ABMS("I")-1)=ABMU(I)
  1.  .S:J=2 $P(ABMF(ABMS("I")),"^",5)=ABMU(I)
  1.  .K ABMU(I)
  1.  S I=$O(ABMU(I)) I '+I K ABMU
  1.  Q