- 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
