- 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
