ABMDTMS ;IHS/ABM/THL - INTERFACE WITH PYXIS/M SYSTEMS;
;;2.6;IHS 3P BILLING SYSTEM;**10,21**;NOV 12, 2009;Build 379
;;
; IHS/SD/SDR - v2.5 p8 - Link to Omnicell
; Code supplied by Carlene McIntyre to connect TPB to Omnicell
;
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*21 - HEAT110091 - Default rev code for Meds to 250
;
EN F D EN1 Q:$D(ABMQUIT)!$D(ABMOUT)
EXITOUT K ABM,ABMAR,ABMDA,ABMDTMS,ABMFL,ABMFN,ABMHDR,ABMI,ABMJ,ABMOUT,ABMQUIT,ABMROU,ABMVALM,ABMX,ABMQUIT,ABMOUT,ABMDA,DFN,VALMBCK,VISDATE,PATIENT,ABMDTMS
K ^TMP("ABMDTMS",$J)
Q
EN1 ;
D EXITOUT
D CLAIM
Q:$D(ABMQUIT)
D DISPLAY
I $D(ABMQUIT) K ABMQUIT Q
Q
CLAIM ;SELECT CLAIM
S DIC="^ABMDCLM("_DUZ(2)_","
S DIC(0)="AEMQZ"
S DIC("A")="Select CLAIM Number: "
W !
D ^DIC K DIC
I +Y<1 S ABMQUIT="" Q
S ABMDA=+Y
CL1 ;CLAIM ALREADY IDENTIFIED
S ABM0=$G(^ABMDCLM(DUZ(2),ABMDA,0))
S DFN=+ABM0,ABMNUM=ABMDA
Q
DISPLAY ;DISPLAY SULLPY ITEMS
D DATE
Q:'$G(ABMBEGIN)!'$G(ABMEND)
D DISP1
Q
DATE ;SELECT DATE RANGE FOR ITEM CHARGES
S PATIENT=$P($G(^DPT(DFN,0)),U)
S FROM=$G(^ABMDCLM(DUZ(2),ABMDA,7))
S TO=$P(FROM,U,2)
S FROM=+FROM
S Y=FROM
X ^DD("DD")
S VISDATE=Y
S Y=TO
I Y X ^DD("DD") S TO=Y
W !!,"PATIENT: ",PATIENT," VISIT DATE: ",VISDATE
W:TO]"" " TO: ",TO
S DIR("B")=VISDATE
S DIR(0)="DO"
S DIR("A")="Beginning Date for Supply/Med Charges"
S DIR("?")="Enter the earliest date to include for supply/med charges"
W !
D ^DIR K DIR
I Y<1 S ABMQUIT="" Q
S ABMBEGIN=+Y
S ABMEND=+Y
S Y=DT
X ^DD("DD")
S DIR("B")=Y
S DIR(0)="DO"
S DIR("A")="Ending Date for Supply/Med Charges"
S DIR("?")="Enter the last date to include for supply/med charges"
W !
D ^DIR K DIR
I 'Y S ABMEND=ABMBEGIN
S ABMEND=+Y
Q
DINIT ;EP;LIST ALL SUPPLY ITEMS IN THE DATE RANGE
K ^TMP("ABMDTMS",$J)
S ABMCNT=0
D HEAD
S ABM=ABMBEGIN-1
F S ABM=$O(^AUPNSUP("ASUP",DFN,ABM)) Q:'ABM!(ABM>(ABMEND+.9999)) D
.S ABMSDA=0
.F S ABMSDA=$O(^AUPNSUP("ASUP",DFN,ABM,ABMSDA)) Q:'ABMSDA D
..D SUPPSET
..Q:ABM0=""
..D FORMAT
S (VALMCNT,ABMJ)=J
Q
SUPPSET ;SET SUPPLY VARIABLES
S ABM0=$G(^AUPNSUP(ABMSDA,0))
S ABM1=$G(^AUPNSUP(ABMSDA,1))
S ABM2=$G(^AUPNSUP(ABMSDA,2))
Q
HEAD ;
S J=0
S X=""
S $E(X,19)="3P NUM: "_ABMNUM
D J
S $E(X,18)="PATIENT: "_PATIENT
D J
S $E(X,9)="ADMIT/VISIT FROM: "_VISDATE_" TO: "_TO
D J
S X=""
S $E(X,51)="TRANCODE/"
S $E(X,67)="REV/"
D J
S X="SUPPLY/MED NAME"
S $E(X,36)="QUAN"
S $E(X,44)="PRICE"
S $E(X,51)="NDC"
S $E(X,61)="HCPC"
S $E(X,67)="DEPT"
S $E(X,72)="CLAIM NO."
D J
S X="--------------------------------------------------------------------------------"
D J
S JHEAD=J
Q
FORMAT ;FORMAT DATA FOR DISPLAY
S SUPPLY=$P(ABM0,U)
S PATIENT=$P($G(^DPT(DFN,0)),U)
S ADMIT=$G(^ABMDCLM(DUZ(2),ABMDA,6))
S DISCHARG=$P(ADMIT,U,3)
S ADMIT=+ADMIT
S FROM=$G(^ABMDCLM(DUZ(2),ABMDA,7))
S TO=$P(FROM,U,2)
S FROM=+FROM
I ADMIT D
.S Y=ADMIT
.X ^DD("DD")
.S ADMIT=Y
I DISCHARG D
.S Y=DISCHARG
.X ^DD("DD")
.S DISCHARG=Y
I FROM D
.S Y=ADMIT
.X ^DD("DD")
.S FROM=Y
I TO D
.S Y=TO
.X ^DD("DD")
.S TO=Y
S Y=$P(ABM0,U,3)
X ^DD("DD")
S ISSUDATE=Y
S CLAIM=$P(ABM0,U,6)
S TRANCODE=$P(ABM1,U)
S MEDDA=$P(ABM1,U,3)
S NDC=$P($G(^PSDRUG(+MEDDA,2)),U,4)
S DEPTCODE=$P(ABM1,U,5)
S QUANTITY=$P(ABM2,U,3)
S PRICE=$P(ABM2,U,4)
S HCPCCODE=$P($$CPT^ABMCVAPI(+$P(ABM2,U,5),FROM),U,2) ;CSV-c
S REVCODE=$P($G(^AUTTREVN(+$P(ABM2,U,6),0)),U)
S ABMCNT=ABMCNT+1
S X=ABMCNT
S $E(X,4)=$E(SUPPLY,1,32)
S $E(X,36)=$J(QUANTITY,4)
S $E(X,40)=$J($FN(PRICE,"P",2),10)
S $E(X,51)=$E(TRANCODE,1,10)
S $E(X,61)=$E(HCPCCODE,1,6)
S $E(X,67)=$E(REVCODE,1,3)
S:CLAIM]"" $E(X,71)=$E(CLAIM,1,10)
D J
S X=" "_ISSUDATE
S $E(X,51)=$E(NDC,1,12)
S $E(X,67)=DEPTCODE
D J
S ^TMP("ABMSUP",$J,ABMCNT)=ABMSDA
Q
ADDITEM ;ADD SUPPLY TO CLAIM
N ABMJ,ABMX
F ABMJ=1:1 S ABMX=$P(ABMSET,",",ABMJ) Q:'ABMX D A1
Q
A1 ;ADD ITEMS TO THE CLAIM
S DA(1)=ABMDA
S ABMSDA=$G(^TMP("ABMSUP",$J,ABMX))
Q:'ABMSDA
D SUPPSET
S X=""
I $P(ABM1,U,3) D I 1
.S X=$P(ABM1,U,3)
.I '$D(^PSDRUG(+X,0)) S X="" Q
.S DIC="^ABMDCLM("_DUZ(2)_","_ABMDA_",23,"
.S $P(^ABMDCLM(DUZ(2),DA(1),23,0),U,2)="9002274.3023P"
.;S DIC("DR")=".02///"_$P(ABM2,U,6)_";.03////"_$P(ABM2,U,3)_";.04////"_$P(ABM2,U,4)_";.05////"_$S($G(DISPFEE):DISPFEE,1:4.5)_";.06////"_$S($P(ABM2,U,7)]"":$P(ABM2,U,7),1:"NOT STATED")_";.14////"_$P(ABM0,U,3) ;;abm*2.6*21 IHS/SD/SDR HEAT110091
.;start new abm*2.6*21 IHS/SD/SDR HEAT110091
.S DIC("DR")=".02///"_$S(+$P(ABM2,U,6)'=0:$P(ABM2,U,6),1:250)_";.03////"_$P(ABM2,U,3)_";.04////"_$P(ABM2,U,4)_";.05////"_$S($G(DISPFEE):DISPFEE,1:4.5)_";.06////"_$S($P(ABM2,U,7)]"":$P(ABM2,U,7),1:"NOT STATED")_";.14////"_$P(ABM0,U,3)
.;end new abm*2.6*21 IHS/SD/SDR HEAT110091
.S DIC("DR")=DIC("DR")_";.24////"_$P($G(^PSDRUG($P(ABM1,U,3),2)),U,4) ;NDC abm*2.6*10 HEAT74646
E I $P(ABM2,U,5) D I 1
.S X=+$P(ABM2,U,5)
.I '$D(^ICPT(+X,0)) S X="" Q
.S DIC="^ABMDCLM("_DUZ(2)_","_ABMDA_",43,"
.S $P(^ABMDCLM(DUZ(2),DA(1),43,0),U,2)="9002274.3043P"
.S DIC("DR")=".02///"_$P(ABM2,U,6)_";.03////"_$P(ABM2,U,3)_";.04////"_$P(ABM2,U,4)_";.06////"_$S($P(ABM2,U,7)]"":$P(ABM2,U,7),1:"NOT STATED")_";.14////"_$P(ABM0,U,3)
E I $P(ABM2,U,6) D I 1
.S X=+$P(ABM2,U,6)
.I '$D(^AUTTREVN(+X,0)) S X="" Q
.S DIC="^ABMDCLM("_DUZ(2)_","_ABMDA_",25,"
.S $P(^ABMDCLM(DUZ(2),DA(1),25,0),U,2)="9002274.3025P"
.S DIC("DR")=".02///"_$P(ABM2,U,3)_";.03////"_$P(ABM2,U,4)_";.04////"_$P(ABM2,U,2)
Q:'X
S DIC(0)="L"
D FILE^DICN
K DIC,DD,DA,DR
S DA=ABMSDA
S DIE="^AUPNSUP("
S DR=".06////"_ABMDA
D ^DIE
K DIC,DD,DIE,DA,DR
Q
DISP1 ;DISPLAY ALL RELEVANT ITEMS
S ABMHDR=""
S ABMVALM="ABMDTMS HL7 SUPPLY LIST"
D VALM(ABMVALM)
Q
SELECT ;EP;SELECT ITEMS TO ADD TO CLAIM
I $G(ABMDTMS)'="E" S ABMDTMS="A"
S DIR(0)="LO^1:"_ABMCNT
S DIR("A")="Select Charges to add or edit"
W !
D ^DIR K DIR
K ABMQUIT
I '+Y D BACK Q
S ABMSET=Y
I ABMDTMS="A" D ADD I 1
E D EDIT
K ABMDTMS
D BACK
D DINIT
Q
ADD D SURE
I $D(ABMQUIT) K ABMQUIT Q
D ADDITEM
Q
SURE ;CONFIRM TRANSFER OF SUPPLIES
W !!,"Are you certain you want to charge these items to the Claim/Bill"
W !,ABMSET
S DIR(0)="YO"
S DIR("A")="Charge these supplies/meds to Claim/Bill "_ABMNUM_" "
S DIR("B")="NO"
W !
D ^DIR K DIR
I 'Y S ABMQUIT="" Q
Q
BACK S VALMBCK="R"
Q
J ;SET TEMP ARRAY
S J=J+1
S ^TMP("ABMDTMS",$J,J,0)=X
S X=""
Q
VALM(ABMVALM) ;EP; -- main entry point for list templates
S VALMSG="- Previous Screen Q Quit ?? for More Actions"
S VALMCC=1 ;1=screen mode, 0=scrolling mode
D BACK
D TERM^VALM0
D CLEAR^VALM1
D EN^VALM(ABMVALM)
D CLEAR^VALM1
Q
OPEN(DFN,ABMDA) ;EP;TO PROCESS WHEN CLAIM ALREAY IDENTIFIED
I $D(ABMDTMS("OUT")) K ABMDTMS Q
S ABMDTMS("OUT")=""
Q:'DFN!'ABMDA
K ABMQUIT
S PATIENT=$P($G(^DPT(DFN,0)),U)
S FROM=$G(^ABMDCLM(DUZ(2),ABMDA,7))
S TO=DT
S FROM=+FROM
N X,Y,Z
S Z=0
S X=FROM-1
F S X=$O(^AUPNSUP("ASUP",DFN,X)) Q:'X!Z!(X>TO) D
.S Y=0
.F S Y=$O(^AUPNSUP("ASUP",DFN,X,Y)) Q:'Y D
..S Z=Z+1
Q:'Z
W @IOF
W !!,"There are SUPPLIES/MEDS on file that may need to be added to this claim."
D CL1
D DISPLAY
Q
HDR ;EP; -- header code
S VALMHDR(1)=$G(ABMHDR)
S VALMSG="- Previous Screen Q Quit ?? for More Actions"
Q
;
HELP ;EP; -- help code
S X="?"
D DISP^XQORM1
W !!
Q
;
EXIT ;EP; -- exit code
K ^TMP("ABMLM",$J)
K ABMAR,ABMDIR,ABMFL,ABMFN,ABMHDR,ABMI,ABMROU,ABMDIR
I '$G(XQORS) D CLEAR^VALM1
Q
EDIN ;
S ABMDTMS="E"
D SELECT
K ABDMTMS
Q
EDIT ;EDIT SUPPLY ITEMS
N ABMJ,ABMX
F ABMJ=1:1 S ABMX=$P(ABMSET,",",ABMJ) Q:'ABMX D E1
Q
E1 ;EDIT ITEMS
S DA=$G(^TMP("ABMSUP",$J,ABMX))
Q:'DA
S DR="[ABMDTMS SUPPLY EDIT]"
S (DDSFILE,DIE)="^AUPNSUP("
D ^DDS
Q
ABMDTMS ;IHS/ABM/THL - INTERFACE WITH PYXIS/M SYSTEMS;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**10,21**;NOV 12, 2009;Build 379
+2 ;;
+3 ; IHS/SD/SDR - v2.5 p8 - Link to Omnicell
+4 ; Code supplied by Carlene McIntyre to connect TPB to Omnicell
+5 ;
+6 ; IHS/SD/SDR - v2.6 CSV
+7 ;IHS/SD/SDR - 2.6*21 - HEAT110091 - Default rev code for Meds to 250
+8 ;
EN FOR
DO EN1
IF $DATA(ABMQUIT)!$DATA(ABMOUT)
QUIT
EXITOUT KILL ABM,ABMAR,ABMDA,ABMDTMS,ABMFL,ABMFN,ABMHDR,ABMI,ABMJ,ABMOUT,ABMQUIT,ABMROU,ABMVALM,ABMX,ABMQUIT,ABMOUT,ABMDA,DFN,VALMBCK,VISDATE,PATIENT,ABMDTMS
+1 KILL ^TMP("ABMDTMS",$JOB)
+2 QUIT
EN1 ;
+1 DO EXITOUT
+2 DO CLAIM
+3 IF $DATA(ABMQUIT)
QUIT
+4 DO DISPLAY
+5 IF $DATA(ABMQUIT)
KILL ABMQUIT
QUIT
+6 QUIT
CLAIM ;SELECT CLAIM
+1 SET DIC="^ABMDCLM("_DUZ(2)_","
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Select CLAIM Number: "
+4 WRITE !
+5 DO ^DIC
KILL DIC
+6 IF +Y<1
SET ABMQUIT=""
QUIT
+7 SET ABMDA=+Y
CL1 ;CLAIM ALREADY IDENTIFIED
+1 SET ABM0=$GET(^ABMDCLM(DUZ(2),ABMDA,0))
+2 SET DFN=+ABM0
SET ABMNUM=ABMDA
+3 QUIT
DISPLAY ;DISPLAY SULLPY ITEMS
+1 DO DATE
+2 IF '$GET(ABMBEGIN)!'$GET(ABMEND)
QUIT
+3 DO DISP1
+4 QUIT
DATE ;SELECT DATE RANGE FOR ITEM CHARGES
+1 SET PATIENT=$PIECE($GET(^DPT(DFN,0)),U)
+2 SET FROM=$GET(^ABMDCLM(DUZ(2),ABMDA,7))
+3 SET TO=$PIECE(FROM,U,2)
+4 SET FROM=+FROM
+5 SET Y=FROM
+6 XECUTE ^DD("DD")
+7 SET VISDATE=Y
+8 SET Y=TO
+9 IF Y
XECUTE ^DD("DD")
SET TO=Y
+10 WRITE !!,"PATIENT: ",PATIENT," VISIT DATE: ",VISDATE
+11 IF TO]""
WRITE " TO: ",TO
+12 SET DIR("B")=VISDATE
+13 SET DIR(0)="DO"
+14 SET DIR("A")="Beginning Date for Supply/Med Charges"
+15 SET DIR("?")="Enter the earliest date to include for supply/med charges"
+16 WRITE !
+17 DO ^DIR
KILL DIR
+18 IF Y<1
SET ABMQUIT=""
QUIT
+19 SET ABMBEGIN=+Y
+20 SET ABMEND=+Y
+21 SET Y=DT
+22 XECUTE ^DD("DD")
+23 SET DIR("B")=Y
+24 SET DIR(0)="DO"
+25 SET DIR("A")="Ending Date for Supply/Med Charges"
+26 SET DIR("?")="Enter the last date to include for supply/med charges"
+27 WRITE !
+28 DO ^DIR
KILL DIR
+29 IF 'Y
SET ABMEND=ABMBEGIN
+30 SET ABMEND=+Y
+31 QUIT
DINIT ;EP;LIST ALL SUPPLY ITEMS IN THE DATE RANGE
+1 KILL ^TMP("ABMDTMS",$JOB)
+2 SET ABMCNT=0
+3 DO HEAD
+4 SET ABM=ABMBEGIN-1
+5 FOR
SET ABM=$ORDER(^AUPNSUP("ASUP",DFN,ABM))
IF 'ABM!(ABM>(ABMEND+.9999))
QUIT
Begin DoDot:1
+6 SET ABMSDA=0
+7 FOR
SET ABMSDA=$ORDER(^AUPNSUP("ASUP",DFN,ABM,ABMSDA))
IF 'ABMSDA
QUIT
Begin DoDot:2
+8 DO SUPPSET
+9 IF ABM0=""
QUIT
+10 DO FORMAT
End DoDot:2
End DoDot:1
+11 SET (VALMCNT,ABMJ)=J
+12 QUIT
SUPPSET ;SET SUPPLY VARIABLES
+1 SET ABM0=$GET(^AUPNSUP(ABMSDA,0))
+2 SET ABM1=$GET(^AUPNSUP(ABMSDA,1))
+3 SET ABM2=$GET(^AUPNSUP(ABMSDA,2))
+4 QUIT
HEAD ;
+1 SET J=0
+2 SET X=""
+3 SET $EXTRACT(X,19)="3P NUM: "_ABMNUM
+4 DO J
+5 SET $EXTRACT(X,18)="PATIENT: "_PATIENT
+6 DO J
+7 SET $EXTRACT(X,9)="ADMIT/VISIT FROM: "_VISDATE_" TO: "_TO
+8 DO J
+9 SET X=""
+10 SET $EXTRACT(X,51)="TRANCODE/"
+11 SET $EXTRACT(X,67)="REV/"
+12 DO J
+13 SET X="SUPPLY/MED NAME"
+14 SET $EXTRACT(X,36)="QUAN"
+15 SET $EXTRACT(X,44)="PRICE"
+16 SET $EXTRACT(X,51)="NDC"
+17 SET $EXTRACT(X,61)="HCPC"
+18 SET $EXTRACT(X,67)="DEPT"
+19 SET $EXTRACT(X,72)="CLAIM NO."
+20 DO J
+21 SET X="--------------------------------------------------------------------------------"
+22 DO J
+23 SET JHEAD=J
+24 QUIT
FORMAT ;FORMAT DATA FOR DISPLAY
+1 SET SUPPLY=$PIECE(ABM0,U)
+2 SET PATIENT=$PIECE($GET(^DPT(DFN,0)),U)
+3 SET ADMIT=$GET(^ABMDCLM(DUZ(2),ABMDA,6))
+4 SET DISCHARG=$PIECE(ADMIT,U,3)
+5 SET ADMIT=+ADMIT
+6 SET FROM=$GET(^ABMDCLM(DUZ(2),ABMDA,7))
+7 SET TO=$PIECE(FROM,U,2)
+8 SET FROM=+FROM
+9 IF ADMIT
Begin DoDot:1
+10 SET Y=ADMIT
+11 XECUTE ^DD("DD")
+12 SET ADMIT=Y
End DoDot:1
+13 IF DISCHARG
Begin DoDot:1
+14 SET Y=DISCHARG
+15 XECUTE ^DD("DD")
+16 SET DISCHARG=Y
End DoDot:1
+17 IF FROM
Begin DoDot:1
+18 SET Y=ADMIT
+19 XECUTE ^DD("DD")
+20 SET FROM=Y
End DoDot:1
+21 IF TO
Begin DoDot:1
+22 SET Y=TO
+23 XECUTE ^DD("DD")
+24 SET TO=Y
End DoDot:1
+25 SET Y=$PIECE(ABM0,U,3)
+26 XECUTE ^DD("DD")
+27 SET ISSUDATE=Y
+28 SET CLAIM=$PIECE(ABM0,U,6)
+29 SET TRANCODE=$PIECE(ABM1,U)
+30 SET MEDDA=$PIECE(ABM1,U,3)
+31 SET NDC=$PIECE($GET(^PSDRUG(+MEDDA,2)),U,4)
+32 SET DEPTCODE=$PIECE(ABM1,U,5)
+33 SET QUANTITY=$PIECE(ABM2,U,3)
+34 SET PRICE=$PIECE(ABM2,U,4)
+35 ;CSV-c
SET HCPCCODE=$PIECE($$CPT^ABMCVAPI(+$PIECE(ABM2,U,5),FROM),U,2)
+36 SET REVCODE=$PIECE($GET(^AUTTREVN(+$PIECE(ABM2,U,6),0)),U)
+37 SET ABMCNT=ABMCNT+1
+38 SET X=ABMCNT
+39 SET $EXTRACT(X,4)=$EXTRACT(SUPPLY,1,32)
+40 SET $EXTRACT(X,36)=$JUSTIFY(QUANTITY,4)
+41 SET $EXTRACT(X,40)=$JUSTIFY($FNUMBER(PRICE,"P",2),10)
+42 SET $EXTRACT(X,51)=$EXTRACT(TRANCODE,1,10)
+43 SET $EXTRACT(X,61)=$EXTRACT(HCPCCODE,1,6)
+44 SET $EXTRACT(X,67)=$EXTRACT(REVCODE,1,3)
+45 IF CLAIM]""
SET $EXTRACT(X,71)=$EXTRACT(CLAIM,1,10)
+46 DO J
+47 SET X=" "_ISSUDATE
+48 SET $EXTRACT(X,51)=$EXTRACT(NDC,1,12)
+49 SET $EXTRACT(X,67)=DEPTCODE
+50 DO J
+51 SET ^TMP("ABMSUP",$JOB,ABMCNT)=ABMSDA
+52 QUIT
ADDITEM ;ADD SUPPLY TO CLAIM
+1 NEW ABMJ,ABMX
+2 FOR ABMJ=1:1
SET ABMX=$PIECE(ABMSET,",",ABMJ)
IF 'ABMX
QUIT
DO A1
+3 QUIT
A1 ;ADD ITEMS TO THE CLAIM
+1 SET DA(1)=ABMDA
+2 SET ABMSDA=$GET(^TMP("ABMSUP",$JOB,ABMX))
+3 IF 'ABMSDA
QUIT
+4 DO SUPPSET
+5 SET X=""
+6 IF $PIECE(ABM1,U,3)
Begin DoDot:1
+7 SET X=$PIECE(ABM1,U,3)
+8 IF '$DATA(^PSDRUG(+X,0))
SET X=""
QUIT
+9 SET DIC="^ABMDCLM("_DUZ(2)_","_ABMDA_",23,"
+10 SET $PIECE(^ABMDCLM(DUZ(2),DA(1),23,0),U,2)="9002274.3023P"
+11 ;S DIC("DR")=".02///"_$P(ABM2,U,6)_";.03////"_$P(ABM2,U,3)_";.04////"_$P(ABM2,U,4)_";.05////"_$S($G(DISPFEE):DISPFEE,1:4.5)_";.06////"_$S($P(ABM2,U,7)]"":$P(ABM2,U,7),1:"NOT STATED")_";.14////"_$P(ABM0,U,3) ;;abm*2.6*21 IHS/SD/SDR HEAT110091
+12 ;start new abm*2.6*21 IHS/SD/SDR HEAT110091
+13 SET DIC("DR")=".02///"_$SELECT(+$PIECE(ABM2,U,6)'=0:$PIECE(ABM2,U,6),1:250)_";.03////"_$PIECE(ABM2,U,3)_";.04////"_...
... $PIECE(ABM2,U,4)_";.05////"_$SELECT">SELECT($GET(DISPFEE):DISPFEE,1:4.5)_";.06////"_$SELECT">SELECT($PIECE(ABM2,U,7)]"":$PIECE(ABM2,U,7),1:"NOT STATED")_";.14////"_$PIECE(ABM0,U,3)
+14 ;end new abm*2.6*21 IHS/SD/SDR HEAT110091
+15 ;NDC abm*2.6*10 HEAT74646
SET DIC("DR")=DIC("DR")_";.24////"_$PIECE($GET(^PSDRUG($PIECE(ABM1,U,3),2)),U,4)
End DoDot:1
IF 1
+16 IF '$TEST
IF $PIECE(ABM2,U,5)
Begin DoDot:1
+17 SET X=+$PIECE(ABM2,U,5)
+18 IF '$DATA(^ICPT(+X,0))
SET X=""
QUIT
+19 SET DIC="^ABMDCLM("_DUZ(2)_","_ABMDA_",43,"
+20 SET $PIECE(^ABMDCLM(DUZ(2),DA(1),43,0),U,2)="9002274.3043P"
+21 SET DIC("DR")=".02///"_$PIECE(ABM2,U,6)_";.03////"_$PIECE(ABM2,U,3)_";.04////"_$PIECE(ABM2,U,4)_";.06////"_$SELECT($PIECE(ABM2,U,7)]"":$PIECE(ABM2,U,7),1:"NOT STATED")_";.14////"_$PIECE(ABM0,U,3)
End DoDot:1
IF 1
+22 IF '$TEST
IF $PIECE(ABM2,U,6)
Begin DoDot:1
+23 SET X=+$PIECE(ABM2,U,6)
+24 IF '$DATA(^AUTTREVN(+X,0))
SET X=""
QUIT
+25 SET DIC="^ABMDCLM("_DUZ(2)_","_ABMDA_",25,"
+26 SET $PIECE(^ABMDCLM(DUZ(2),DA(1),25,0),U,2)="9002274.3025P"
+27 SET DIC("DR")=".02///"_$PIECE(ABM2,U,3)_";.03////"_$PIECE(ABM2,U,4)_";.04////"_$PIECE(ABM2,U,2)
End DoDot:1
IF 1
+28 IF 'X
QUIT
+29 SET DIC(0)="L"
+30 DO FILE^DICN
+31 KILL DIC,DD,DA,DR
+32 SET DA=ABMSDA
+33 SET DIE="^AUPNSUP("
+34 SET DR=".06////"_ABMDA
+35 DO ^DIE
+36 KILL DIC,DD,DIE,DA,DR
+37 QUIT
DISP1 ;DISPLAY ALL RELEVANT ITEMS
+1 SET ABMHDR=""
+2 SET ABMVALM="ABMDTMS HL7 SUPPLY LIST"
+3 DO VALM(ABMVALM)
+4 QUIT
SELECT ;EP;SELECT ITEMS TO ADD TO CLAIM
+1 IF $GET(ABMDTMS)'="E"
SET ABMDTMS="A"
+2 SET DIR(0)="LO^1:"_ABMCNT
+3 SET DIR("A")="Select Charges to add or edit"
+4 WRITE !
+5 DO ^DIR
KILL DIR
+6 KILL ABMQUIT
+7 IF '+Y
DO BACK
QUIT
+8 SET ABMSET=Y
+9 IF ABMDTMS="A"
DO ADD
IF 1
+10 IF '$TEST
DO EDIT
+11 KILL ABMDTMS
+12 DO BACK
+13 DO DINIT
+14 QUIT
ADD DO SURE
+1 IF $DATA(ABMQUIT)
KILL ABMQUIT
QUIT
+2 DO ADDITEM
+3 QUIT
SURE ;CONFIRM TRANSFER OF SUPPLIES
+1 WRITE !!,"Are you certain you want to charge these items to the Claim/Bill"
+2 WRITE !,ABMSET
+3 SET DIR(0)="YO"
+4 SET DIR("A")="Charge these supplies/meds to Claim/Bill "_ABMNUM_" "
+5 SET DIR("B")="NO"
+6 WRITE !
+7 DO ^DIR
KILL DIR
+8 IF 'Y
SET ABMQUIT=""
QUIT
+9 QUIT
BACK SET VALMBCK="R"
+1 QUIT
J ;SET TEMP ARRAY
+1 SET J=J+1
+2 SET ^TMP("ABMDTMS",$JOB,J,0)=X
+3 SET X=""
+4 QUIT
VALM(ABMVALM) ;EP; -- main entry point for list templates
+1 SET VALMSG="- Previous Screen Q Quit ?? for More Actions"
+2 ;1=screen mode, 0=scrolling mode
SET VALMCC=1
+3 DO BACK
+4 DO TERM^VALM0
+5 DO CLEAR^VALM1
+6 DO EN^VALM(ABMVALM)
+7 DO CLEAR^VALM1
+8 QUIT
OPEN(DFN,ABMDA) ;EP;TO PROCESS WHEN CLAIM ALREAY IDENTIFIED
+1 IF $DATA(ABMDTMS("OUT"))
KILL ABMDTMS
QUIT
+2 SET ABMDTMS("OUT")=""
+3 IF 'DFN!'ABMDA
QUIT
+4 KILL ABMQUIT
+5 SET PATIENT=$PIECE($GET(^DPT(DFN,0)),U)
+6 SET FROM=$GET(^ABMDCLM(DUZ(2),ABMDA,7))
+7 SET TO=DT
+8 SET FROM=+FROM
+9 NEW X,Y,Z
+10 SET Z=0
+11 SET X=FROM-1
+12 FOR
SET X=$ORDER(^AUPNSUP("ASUP",DFN,X))
IF 'X!Z!(X>TO)
QUIT
Begin DoDot:1
+13 SET Y=0
+14 FOR
SET Y=$ORDER(^AUPNSUP("ASUP",DFN,X,Y))
IF 'Y
QUIT
Begin DoDot:2
+15 SET Z=Z+1
End DoDot:2
End DoDot:1
+16 IF 'Z
QUIT
+17 WRITE @IOF
+18 WRITE !!,"There are SUPPLIES/MEDS on file that may need to be added to this claim."
+19 DO CL1
+20 DO DISPLAY
+21 QUIT
HDR ;EP; -- header code
+1 SET VALMHDR(1)=$GET(ABMHDR)
+2 SET VALMSG="- Previous Screen Q Quit ?? for More Actions"
+3 QUIT
+4 ;
HELP ;EP; -- help code
+1 SET X="?"
+2 DO DISP^XQORM1
+3 WRITE !!
+4 QUIT
+5 ;
EXIT ;EP; -- exit code
+1 KILL ^TMP("ABMLM",$JOB)
+2 KILL ABMAR,ABMDIR,ABMFL,ABMFN,ABMHDR,ABMI,ABMROU,ABMDIR
+3 IF '$GET(XQORS)
DO CLEAR^VALM1
+4 QUIT
EDIN ;
+1 SET ABMDTMS="E"
+2 DO SELECT
+3 KILL ABDMTMS
+4 QUIT
EDIT ;EDIT SUPPLY ITEMS
+1 NEW ABMJ,ABMX
+2 FOR ABMJ=1:1
SET ABMX=$PIECE(ABMSET,",",ABMJ)
IF 'ABMX
QUIT
DO E1
+3 QUIT
E1 ;EDIT ITEMS
+1 SET DA=$GET(^TMP("ABMSUP",$JOB,ABMX))
+2 IF 'DA
QUIT
+3 SET DR="[ABMDTMS SUPPLY EDIT]"
+4 SET (DDSFILE,DIE)="^AUPNSUP("
+5 DO ^DDS
+6 QUIT
