ABMDRPCC ; IHS/ASDST/DMJ - View PCC Visit ;
;;2.6;IHS 3P BILLING SYSTEM;**11,21**;NOV 12, 2009;Build 379
;IHS/SD/SDR -2.6*21 HEAT210601 - Added Q to stop LOOP if timeout or '^'; was causing <SUBSCR>LOOP+20^ABMDRPCC error
;
START ;START HERE
K APCDVDSP
W !
S AUPNLK("ALL")="" ;universal lookup ;abm*2.6*11 NOHEAT6
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC Q:Y<0 S APCDPAT=+Y
S ABM("PNM")=$P(^DPT(APCDPAT,0),U),ABM("SSN")=$P(^(0),"^",9)
S ABM("SSN")=$E(ABM("SSN"),1,3)_"-"_$E(ABM("SSN"),4,5)_"-"_$E(ABM("SSN"),6,9)
S $P(ABM("EQ"),"=",80)="",ABM("I")=0 D HDR
LOOP ;LOOP HERE
S ABM("VDT")=0 F S ABM("VDT")=$O(^AUPNVSIT("AA",APCDPAT,ABM("VDT"))) Q:'ABM("VDT")!($G(ABM("QUIT"))) D
.S ABM("VDFN")=0 F S ABM("VDFN")=$O(^AUPNVSIT("AA",APCDPAT,ABM("VDT"),ABM("VDFN"))) Q:'ABM("VDFN")!($G(ABM("QUIT"))) D
..Q:$P(^AUPNVSIT(ABM("VDFN"),0),"^",11)
..S ABM("I")=ABM("I")+1,ABMN(ABM("I"))=ABM("VDFN")
..K ABM(9000010)
..S DIC="^AUPNVSIT(",DIQ="ABM(",DIQ(0)="E",DR=".01;.04;.06;.07",DA=ABM("VDFN") D EN^DIQ1 K DIQ
..W !,$J("("_ABM("I")_")",6)
..W ?9,ABM(9000010,DA,.01,"E")
..W ?30,$E(ABM(9000010,DA,.06,"E"),1,17)
..W ?50,ABM(9000010,DA,.07,"E")
..W !,?10,"Claim Status: ",ABM(9000010,DA,.04,"E")
..I $Y+5>IOSL,'(ABM("I")#2) D
...W ! S DIR(0)="NO^"_ABM("PST")_":"_ABM("I") D ^DIR K DIR
...I X S APCDVDSP=ABMN(X),ABM("QUIT")=1 Q
...I Y["^" S ABM("QUIT")=1 Q
...D HDR
I '$D(ABMN) W !,"No PCC Visits Found for This Patient.",! S DIR(0)="E" D ^DIR K DIR K ABM Q
I $G(ABM("QUIT")),'$G(APCDVDSP) K ABM Q
I '$G(APCDVDSP) S DIR(0)="N^"_ABM("PST")_":"_ABM("I") D ^DIR K DIR I Y["^" K ABM Q
Q:X=""!$D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) ;abm*2.6*21 IHS/SD/SDR HEAT210601
S APCDVDSP=ABMN(X)
K ABM,ABMN
DEV ;ASK FOR DEVICE
S %ZIS("A")="Enter Device: ",%ZIS="NQ" D ^%ZIS Q:POP
I IO'=IO(0) D QUE,HOME^%ZIS Q
I $D(IO("S")) S IOP=ION D ^%ZIS
TM ;TASKMAN COME HERE
D ^APCDVDSP
I $E(IOST)="P" W $$EN^ABMVDF("IOF")
K APCDPAT,APCDVDSP Q
HDR ;HEADER
K ABMN
S ABM("PST")=ABM("I")+1
W $$EN^ABMVDF("IOF"),!,"PATIENT: ",ABM("PNM"),?40,"SSN: ",ABM("SSN")
W !,?9,"VISIT DATE/TIME",?30,"VISIT LOCATION",?50,"SERVICE CATEGORY",!,ABM("EQ"),!
Q
QUE ;QUE TO TASKMAN
S ZTRTN="TM^ABMDVPCC",ZTDESC="PCC INQUIRY"
S ZTSAVE("APCDVDSP")="",ZTSAVE("APCDPAT")=""
K ZTSK D ^%ZTLOAD W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!
Q
ABMDRPCC ; IHS/ASDST/DMJ - View PCC Visit ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR -2.6*21 HEAT210601 - Added Q to stop LOOP if timeout or '^'; was causing <SUBSCR>LOOP+20^ABMDRPCC error
+3 ;
START ;START HERE
+1 KILL APCDVDSP
+2 WRITE !
+3 ;universal lookup ;abm*2.6*11 NOHEAT6
SET AUPNLK("ALL")=""
+4 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
IF Y<0
QUIT
SET APCDPAT=+Y
+5 SET ABM("PNM")=$PIECE(^DPT(APCDPAT,0),U)
SET ABM("SSN")=$PIECE(^(0),"^",9)
+6 SET ABM("SSN")=$EXTRACT(ABM("SSN"),1,3)_"-"_$EXTRACT(ABM("SSN"),4,5)_"-"_$EXTRACT(ABM("SSN"),6,9)
+7 SET $PIECE(ABM("EQ"),"=",80)=""
SET ABM("I")=0
DO HDR
LOOP ;LOOP HERE
+1 SET ABM("VDT")=0
FOR
SET ABM("VDT")=$ORDER(^AUPNVSIT("AA",APCDPAT,ABM("VDT")))
IF 'ABM("VDT")!($GET(ABM("QUIT")))
QUIT
Begin DoDot:1
+2 SET ABM("VDFN")=0
FOR
SET ABM("VDFN")=$ORDER(^AUPNVSIT("AA",APCDPAT,ABM("VDT"),ABM("VDFN")))
IF 'ABM("VDFN")!($GET(ABM("QUIT")))
QUIT
Begin DoDot:2
+3 IF $PIECE(^AUPNVSIT(ABM("VDFN"),0),"^",11)
QUIT
+4 SET ABM("I")=ABM("I")+1
SET ABMN(ABM("I"))=ABM("VDFN")
+5 KILL ABM(9000010)
+6 SET DIC="^AUPNVSIT("
SET DIQ="ABM("
SET DIQ(0)="E"
SET DR=".01;.04;.06;.07"
SET DA=ABM("VDFN")
DO EN^DIQ1
KILL DIQ
+7 WRITE !,$JUSTIFY("("_ABM("I")_")",6)
+8 WRITE ?9,ABM(9000010,DA,.01,"E")
+9 WRITE ?30,$EXTRACT(ABM(9000010,DA,.06,"E"),1,17)
+10 WRITE ?50,ABM(9000010,DA,.07,"E")
+11 WRITE !,?10,"Claim Status: ",ABM(9000010,DA,.04,"E")
+12 IF $Y+5>IOSL
IF '(ABM("I")#2)
Begin DoDot:3
+13 WRITE !
SET DIR(0)="NO^"_ABM("PST")_":"_ABM("I")
DO ^DIR
KILL DIR
+14 IF X
SET APCDVDSP=ABMN(X)
SET ABM("QUIT")=1
QUIT
+15 IF Y["^"
SET ABM("QUIT")=1
QUIT
+16 DO HDR
End DoDot:3
End DoDot:2
End DoDot:1
+17 IF '$DATA(ABMN)
WRITE !,"No PCC Visits Found for This Patient.",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
KILL ABM
QUIT
+18 IF $GET(ABM("QUIT"))
IF '$GET(APCDVDSP)
KILL ABM
QUIT
+19 IF '$GET(APCDVDSP)
SET DIR(0)="N^"_ABM("PST")_":"_ABM("I")
DO ^DIR
KILL DIR
IF Y["^"
KILL ABM
QUIT
+20 ;abm*2.6*21 IHS/SD/SDR HEAT210601
IF X=""!$DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+21 SET APCDVDSP=ABMN(X)
+22 KILL ABM,ABMN
DEV ;ASK FOR DEVICE
+1 SET %ZIS("A")="Enter Device: "
SET %ZIS="NQ"
DO ^%ZIS
IF POP
QUIT
+2 IF IO'=IO(0)
DO QUE
DO HOME^%ZIS
QUIT
+3 IF $DATA(IO("S"))
SET IOP=ION
DO ^%ZIS
TM ;TASKMAN COME HERE
+1 DO ^APCDVDSP
+2 IF $EXTRACT(IOST)="P"
WRITE $$EN^ABMVDF("IOF")
+3 KILL APCDPAT,APCDVDSP
QUIT
HDR ;HEADER
+1 KILL ABMN
+2 SET ABM("PST")=ABM("I")+1
+3 WRITE $$EN^ABMVDF("IOF"),!,"PATIENT: ",ABM("PNM"),?40,"SSN: ",ABM("SSN")
+4 WRITE !,?9,"VISIT DATE/TIME",?30,"VISIT LOCATION",?50,"SERVICE CATEGORY",!,ABM("EQ"),!
+5 QUIT
QUE ;QUE TO TASKMAN
+1 SET ZTRTN="TM^ABMDVPCC"
SET ZTDESC="PCC INQUIRY"
+2 SET ZTSAVE("APCDVDSP")=""
SET ZTSAVE("APCDPAT")=""
+3 KILL ZTSK
DO ^%ZTLOAD
IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK," queued.",!
+4 QUIT
