ABMDLCPT ; IHS/SD/SDR - REPORT OF CPT codes ;
;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
;
S U="^"
SEL K DIR,DIC,DIE,X,Y,DA,DR
S DIR(0)="PO^81"
S DIR("A")="START WITH CPT CODE"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I X="" S Y=0
S ABMFROM=+Y
I ABMFROM'=0 D
.K DIR,DIC,DIE,X,Y,DA,DR
.S DIR(0)="PO^81"
.S DIR("A")="FINISH WITH CPT CODE"
.D ^DIR K DIR
.Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.S ABMTO=+Y
I +$G(ABMTO)<1 S ABMTO=$O(^ICPT(9999999999),-1)
;
W1 W !!!
S %ZIS="NQ",%ZIS("B")=""
D ^%ZIS G:'$D(IO)!$G(POP) XIT
S ABM("ION")=ION G:$D(IO("Q")) QUE
I IO'=IO(0),$E(IOST)'="C",'$D(IO("S")),$P($G(^ABMDPARM(DUZ(2),1,0)),U,13)="Y" W !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",! G QUE
PRQUE ;EP - Entry Point for Taskman
S ABM("PG")=0
S ABM("HD",0)="CPT FILE LISTING"
I ABMFROM'=0 S ABM("HD",1)="SELECTED RANGE: "_$P($G(^ICPT(ABMFROM,0)),U)_" TO "_$P($G(^ICPT(ABMTO,0)),U)
D HDB
D SET
W !!,$$EN^ABMVDF("HIN"),"E N D O F R E P O R T",$$EN^ABMVDF("HIF"),!
XIT ;
D ^%ZISC
K ABM
Q
;
QUE K IO("Q")
S ZTRTN="PRQUE^ABMDLCPT"
S ZTDESC="REPORT OF CPT CODES"
F ABM="ABM(" S ZTSAVE(ABM)=""
D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",! G XIT
;
SET ;
S:ABMFROM>0 ABMFROM=ABMFROM-.1
F S ABMFROM=$O(^ICPT(ABMFROM)) Q:(+ABMFROM=0!(+$G(ABMTO)'=0&(ABMFROM>ABMTO))) D Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
.K ABMZ
.;.01=CPT CODE
.;2=SHORT DESC
.;5=INACTIVE FLAG
.;9999999.1=coor. dx (CSV)
.;4=coor. dx (pre-CSV)
.I $$VERSION^XPDUTL("BCSV")>0 D GETS^DIQ(81,ABMFROM,".01;2;5;81.04*","EZ","ABMZ")
.I $$VERSION^XPDUTL("BCSV")<1 D GETS^DIQ(81,ABMFROM,".01;2;5;4*","EZ","ABMZ")
.S ABMIEN=ABMFROM_","
.W !?2,ABMZ(81,ABMIEN,".01","E") ;cpt code
.W ?10,ABMZ(81,ABMIEN,"2","E") ;short description
.W ?55,$S($G(ABMZ(81,ABMIEN,"5","E"))=1:"INACTIVE",1:"") ;inactive flag
.S ABMCD=""
.F S ABMCD=$O(ABMZ(81.04,ABMCD)) Q:ABMCD="" D
..W ?65,$G(ABMZ(81.04,ABMCD,.01,"E"))
..I $O(ABMZ(81.04,ABMCD))'="" W !
.I $Y>(IOSL-5) D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT) D HDB Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W !," (cont)" Q
Q
HDB ;
S ABM("PG")=+$G(ABM("PG"))+1
D WHD^ABMDRHD
W !,"CPT CODE",?10,"SHORT DESCRIPTION",?55,"INACTIVE FLAG",?65,"COOR. DX"
Q
ABMDLCPT ; IHS/SD/SDR - REPORT OF CPT codes ;
+1 ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
+2 ;
+3 SET U="^"
SEL KILL DIR,DIC,DIE,X,Y,DA,DR
+1 SET DIR(0)="PO^81"
+2 SET DIR("A")="START WITH CPT CODE"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+5 IF X=""
SET Y=0
+6 SET ABMFROM=+Y
+7 IF ABMFROM'=0
Begin DoDot:1
+8 KILL DIR,DIC,DIE,X,Y,DA,DR
+9 SET DIR(0)="PO^81"
+10 SET DIR("A")="FINISH WITH CPT CODE"
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+13 SET ABMTO=+Y
End DoDot:1
+14 IF +$GET(ABMTO)<1
SET ABMTO=$ORDER(^ICPT(9999999999),-1)
+15 ;
W1 WRITE !!!
+1 SET %ZIS="NQ"
SET %ZIS("B")=""
+2 DO ^%ZIS
IF '$DATA(IO)!$GET(POP)
GOTO XIT
+3 SET ABM("ION")=ION
IF $DATA(IO("Q"))
GOTO QUE
+4 IF IO'=IO(0)
IF $EXTRACT(IOST)'="C"
IF '$DATA(IO("S"))
IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,13)="Y"
WRITE !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",!
GOTO QUE
PRQUE ;EP - Entry Point for Taskman
+1 SET ABM("PG")=0
+2 SET ABM("HD",0)="CPT FILE LISTING"
+3 IF ABMFROM'=0
SET ABM("HD",1)="SELECTED RANGE: "_$PIECE($GET(^ICPT(ABMFROM,0)),U)_" TO "_$PIECE($GET(^ICPT(ABMTO,0)),U)
+4 DO HDB
+5 DO SET
+6 WRITE !!,$$EN^ABMVDF("HIN"),"E N D O F R E P O R T",$$EN^ABMVDF("HIF"),!
XIT ;
+1 DO ^%ZISC
+2 KILL ABM
+3 QUIT
+4 ;
QUE KILL IO("Q")
+1 SET ZTRTN="PRQUE^ABMDLCPT"
+2 SET ZTDESC="REPORT OF CPT CODES"
+3 FOR ABM="ABM("
SET ZTSAVE(ABM)=""
+4 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"REQUEST QUEUED!",!
GOTO XIT
+5 ;
SET ;
+1 IF ABMFROM>0
SET ABMFROM=ABMFROM-.1
+2 FOR
SET ABMFROM=$ORDER(^ICPT(ABMFROM))
IF (+ABMFROM=0!(+$GET(ABMTO)'=0&(ABMFROM>ABMTO)))
QUIT
Begin DoDot:1
+3 KILL ABMZ
+4 ;.01=CPT CODE
+5 ;2=SHORT DESC
+6 ;5=INACTIVE FLAG
+7 ;9999999.1=coor. dx (CSV)
+8 ;4=coor. dx (pre-CSV)
+9 IF $$VERSION^XPDUTL("BCSV")>0
DO GETS^DIQ(81,ABMFROM,".01;2;5;81.04*","EZ","ABMZ")
+10 IF $$VERSION^XPDUTL("BCSV")<1
DO GETS^DIQ(81,ABMFROM,".01;2;5;4*","EZ","ABMZ")
+11 SET ABMIEN=ABMFROM_","
+12 ;cpt code
WRITE !?2,ABMZ(81,ABMIEN,".01","E")
+13 ;short description
WRITE ?10,ABMZ(81,ABMIEN,"2","E")
+14 ;inactive flag
WRITE ?55,$SELECT($GET(ABMZ(81,ABMIEN,"5","E"))=1:"INACTIVE",1:"")
+15 SET ABMCD=""
+16 FOR
SET ABMCD=$ORDER(ABMZ(81.04,ABMCD))
IF ABMCD=""
QUIT
Begin DoDot:2
+17 WRITE ?65,$GET(ABMZ(81.04,ABMCD,.01,"E"))
+18 IF $ORDER(ABMZ(81.04,ABMCD))'=""
WRITE !
End DoDot:2
+19 IF $Y>(IOSL-5)
DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!$DATA(DIRUT)
QUIT
DO HDB
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE !," (cont)"
QUIT
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
+20 QUIT
HDB ;
+1 SET ABM("PG")=+$GET(ABM("PG"))+1
+2 DO WHD^ABMDRHD
+3 WRITE !,"CPT CODE",?10,"SHORT DESCRIPTION",?55,"INACTIVE FLAG",?65,"COOR. DX"
+4 QUIT
