Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDE8D

ABMDE8D.m

Go to the documentation of this file. 
  1. ABMDE8D ; IHS/SD/SDR - Page 8 - MEDICATIONS ; APR 05, 2002
  1.  ;;2.6;IHS Third Party Billing System;**2,7,9,19,21**;NOV 12, 2009;Build 379
  1.  ;
  1.  ;IHS/SD/SDR - V2.5 P8 - Rewrote routine - Request to completely change display
  1.  ;IHS/SD/SDR - v2.5 p9 - IM16660 - 4-digit revenue codes
  1.  ;IHS/SD/SDR - v2.5 p9 - task 1 - Use service line provider multiple
  1.  ;IHS/SD/SDR - v2.5 p11 - NPI
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*2 - 3PMS10003A - Modified to call ABMFEAPI
  1.  ;IHS/SD/SDR - 2.6*19 - HEAT173117 - Added code to prompt for CPT Narrative if necessary for med.
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT168435 - Added code to display/add/edit pharmacy modifiers
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT207995 - Gave user ability to edit NDC even when a prescription from the
  1.  ;  prescription file is selected.  They want ability to remove dashes in NDC.
  1.  ;
  1. DISP K ABMZ,DIC
  1.  S ABMZ("TITL")="MEDICATIONS",ABMZ("PG")="8D"
  1.  I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
  1.  E  D SUM^ABMDE1
  1.  ;
  1.  D D^ABMDE8X
  1.  S $P(ABMZ("="),"=",81)=""
  1.  S ABMZ("SUB")=23,ABMZ("DIAG")=";.13"
  1.  S ABMZ("ITEM")="Medication",ABMZ("DIC")="^PSDRUG("
  1.  S ABMZ("X")="X",(ABM("FEE"),ABMZ("TOTL"))=0
  1.  D HD G LOOP
  1. HD W !?5,"REVN",?11,"CHARGE",?60,"DAYS",?74,"TOTAL"
  1.  W !?5,"CODE",?11,"DATE",?30,"MEDICATION",?60,"SUPPLY",?68,"QTY",?74,"CHARGE"
  1.  W !,ABMZ("=")
  1.  Q
  1. LOOP S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM)) Q:'ABM  S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D PC1
  1.  I ABMZ("NUM")>0 W !,?72,"========",!?5,"TOTAL",?71,$J("$"_($FN(ABMZ("TOTL"),",",2)),9)
  1.  I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
  1.  G XIT
  1.  ;
  1. PC1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),0)
  1.  S ABM("X2")=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),2))  ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  S ABMZ("UNIT")=$P(ABM("X0"),U,3)
  1.  S:'+ABMZ("UNIT") ABMZ("UNIT")=1
  1.  Q:'$D(^PSDRUG(+ABM("X0"),0))  S ABMZ(ABM("I"))=$P(^(0),U)_U_ABM("X")_U_$P(ABM("X0"),U,2)
  1. EOP I $Y>(IOSL-8) D PAUSE^ABMDE1,HD
  1.  W !,"[",ABM("I"),"]"
  1.  I $P(ABM("X0"),U,14) D
  1.  .W ?5,$$GETREV^ABMDUTL($P(ABM("X0"),U,2))  ;rev code
  1.  .W ?11,$$CDT^ABMDUTL($P(ABM("X0"),U,14))  ;charge date
  1.  .I $P(ABM("X0"),U,28)'="",($P(ABM("X0"),U,14)'=$P(ABM("X0"),U,28)) W "-",$$CDT^ABMDUTL($P(ABM("X0"),U,28))
  1.  I $P(ABM("X0"),U,26)'="" W " (+)"  ;date disc
  1.  I $P(ABM("X0"),U,27)'="" W " (*)"  ;RTS
  1.  W ?30,$S($P(ABM("X0"),U,22)]"":"  Rx:"_$P($G(^PSRX($P(ABM("X0"),U,22),0)),U)_" ",$P($G(ABM("X0")),U,6)'="":" Rx: "_$P(ABM("X0"),U,6)_" ",1:"<No Rx>")  ;Rx number
  1.  I $P(ABM("X0"),U,29)'="" W ?40,"CPT: ",$P($$CPT^ABMCVAPI(+$P(ABM("X0"),U,29),ABMP("VDT")),U,2)  ;abm*2.6*7 HEAT30524
  1.  S ABMZ("MOD")=""  ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  F ABM("M")=3,4,5 S:$P(ABM("X2"),U,ABM("M"))]"" ABMZ("MOD")=ABMZ("MOD")_"-"_$P(ABM("X2"),U,ABM("M"))  ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  W:ABMZ("MOD")]"" ABMZ("MOD")_" "  ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  S ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),"P","C","D",0))
  1.  S:ABMRPRV="" ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),"P","C","R",0))
  1.  I ABMRPRV'="" D  ;rendering provider on line item
  1.  .;W " ("_$P($G(^VA(200,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),"P",ABMRPRV,0),U),0)),U)_"-"_$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),"P",ABMRPRV,0),U,2)_")"  ;abm*2.6*7 HEAT30524
  1.  .;W !?51," ("_$E($P($G(^VA(200,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),"P",ABMRPRV,0),U),0)),U),1,23)_"-"_$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),"P",ABMRPRV,0),U,2)_")"  ;abm*2.6*7 HEAT30524  ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  .W !?40," ("_$E($P($G(^VA(200,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),"P",ABMRPRV,0),U),0)),U),1,23)_"-"_$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABM("X"),"P",ABMRPRV,0),U,2)_")"  ;abm*2.6*7 HEAT30524  ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  W !
  1.  W ?4,$S($P($G(ABM("X0")),U,24)]"":$P(ABM("X0"),U,24)_" ",1:"<NO NDC>        ")  ;NDC number
  1.  S ABMU("TXT")=$P(ABMZ(ABM("I")),U)  ;Medication
  1.  N M7,M8,M9
  1.  S M7=$P(ABM("X0"),U,7)  ;additive
  1.  S M8=$P(ABM("X0"),U,8)  ;solution
  1.  S M9=" "_$P(ABM("X0"),U,9)  ;narrative
  1.  S ABMU("TXT")=ABMU("TXT")_" "_$S(M7&($D(^PS(52.6,+M7,0))):$P(^PS(52.6,M7,0),U)_M9,M8&($D(^PS(52.7,+M8,0))):$P(^(0),U)_M9,1:"")
  1.  S ABMU("RM")=57
  1.  S ABMU("LM")=22
  1.  D ^ABMDWRAP
  1.  W ?60,$J($P(ABM("X0"),U,20),3)  ;days supply
  1.  W ?68,$J(ABMZ("UNIT"),3)  ;quantity
  1.  W ?72,$J($FN(($P(ABM("X0"),U,4)*ABMZ("UNIT"))+$P(ABM("X0"),U,5),",",2),8)  ;total charge
  1.  I $P(ABM("X0"),U,6)]"" D
  1.  .N DA S DA=$O(^PSRX("B",$P(ABM("X0"),"^",6),0)) Q:'DA
  1.  .S DIC="^PSRX(",DR=12,DIQ="ABM(",DIQ(0)="E" D EN^DIQ1 K DIQ
  1.  .Q:ABM(52,DA,12,"E")=""
  1.  .S ABMU("TXT")=$G(ABMU("TXT"))_" Comments: "_ABM(52,DA,12,"E")
  1.  S ABM("FEE")=ABM("FEE")+$P(ABM("X0"),U,5)
  1.  S ABMZ("CHARGE")=+$P(ABM("X0"),U,4)  ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  ;S ABMZ("TOTL")=(ABMZ("UNIT")*$P(ABM("X0"),U,4))+ABMZ("TOTL")+$P(ABM("X0"),U,5)  ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  S ABMZ("TOTL")=(ABMZ("UNIT")*ABMZ("CHARGE"))+ABMZ("TOTL")+$P(ABM("X0"),U,5)  ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  Q
  1. XIT K ABM,ABMMODE
  1.  Q
  1. A ;EP  ADD ENTRY
  1.  K DIC
  1.  S DIC="^PSDRUG("
  1.  S DIC(0)="AEMQ"
  1.  S DIC("P")=$P(^DD(9002274.3,23,0),U,2)
  1.  D ^DIC
  1.  Q:+Y<0  S ABMZ("DRUG")=+Y
  1.  S DA(1)=ABMP("CDFN")
  1.  S DIC="^ABMDCLM(DUZ(2),DA(1),23,",X=+Y
  1.  S ABMX("Y")=X,$P(ABMZ(ABMX("Y")),U,2)=X ;abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  K DD,DO
  1.  D FILE^DICN
  1.  Q:Y<0  S DA=+Y
  1.  I '$G(ABMZ("NUM")) S ABMZ("NUM")=1
  1. E ;EDIT EXISTING ENTRY
  1.  I +$G(ABMZ("NUM"))=0 W *7,!!,"There are no entries to edit, you must first ADD an entry.",! K DIR S DIR(0)="E" D ^DIR K DIR Q
  1.  I '$G(ABMZ("DRUG")) D  Q:'Y
  1.  .S DA(1)=ABMP("CDFN")
  1.  .I ABMZ("NUM")=1 S Y=1
  1.  .E  S DIR(0)="NO^1:"_ABMZ("NUM") D ^DIR K DIR Q:'Y
  1.  .S DA=$P(ABMZ(Y),U,2)
  1.  .S ABMZ("DRUG")=$P(^ABMDCLM(DUZ(2),DA(1),23,DA,0),U)
  1.  D MODE^ABMDE8X
  1.  S DIE="^ABMDCLM(DUZ(2),DA(1),23,"
  1.  ;start new abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  S ABMX("Y")=DA,$P(ABMZ(ABMX("Y")),U,2)=DA
  1.  S ABMZ("MOD")=.31_U_3_U_.32_U_.33
  1.  D MOD3^ABMDEMLC
  1.  ;end new abm*2.6*21 IHS/SD/SDR HEAT168435
  1.  D PPDU Q:$D(DIRUT)
  1.  S DR=DR_".22Prescription"
  1.  S ABMSCRIP=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0)),U,22)
  1.  D ^DIE
  1.  I ABMSCRIP'="",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0)),U,22)="" D  Q  ;the Prescription was removed
  1.  .K DIR,DIE,DIC
  1.  .S DA(1)=ABMP("CDFN")
  1.  .S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",23,"
  1.  .D ^DIK
  1.  ;if prescription, get data from there and just ask about Dxs
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0)),U,22)'="" D
  1.  .S ABMIEN=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0)),U,22)
  1.  .K DR
  1.  .S DR=".06////@"  ;remove other Prescription#
  1.  .S DR=DR_";.03Units (at $"_ABMZ("PPDU")_" per unit)//"_$P($G(^PSRX(ABMIEN,0)),U,7)_";.04///"_ABMZ("PPDU") D ^DIE
  1.  .D DFEE S DR=".16Times Dispensed (at $"_ABMZ("DISPFEE")_" per each time dispensed) //1"
  1.  .D ^DIE Q:$D(Y)
  1.  .S DR=".05///"_(ABMZ("DISPFEE")*X) D ^DIE
  1.  .S DR=".25////"_$P($G(^PSRX(ABMIEN,0)),U,13)  ;date written
  1.  .S DR=DR_";.2////"_$P($G(^PSRX(ABMIEN,0)),U,8)  ;days supply
  1.  .;S DR=DR_";.24////"_$P($G(^PSRX(ABMIEN,2)),U,7)  ;NDC  ;abm*2.6*21 IHS/SD/SDR HEAT207995
  1.  .S DR=DR_";.24//"_$P($G(^PSRX(ABMIEN,2)),U,7)  ;NDC  ;abm*2.6*21 IHS/SD/SDR HEAT207995
  1.  .S DR=DR_";.29//"  ;CPT code  ;abm*2.6*7 HEAT30524
  1.  .D ^DIE
  1.  .D NARR  ;abm*2.6*19 IHS/SD/SDR HEAT173117
  1.  .D PROV
  1.  ;
  1.  ;no prescription, prompt for all fields
  1.  ;E  D  ;abm*2.6*19 IHS/SD/SDR HEAT173117
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0)),U,22)="" D  ;abm*2.6*19 IHS/SD/SDR HEAT173117
  1.  .S DR=".14//"_$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0)),U,14)'="":$$SDT^ABMDUTL($P(^(0),U,14)),$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,1)'=$P(^(7),U,2):$$SDT^ABMDUTL($P(^(7),U)),1:"/"_$$SDT^ABMDUTL($P(^(7),U)))
  1.  .S DR=DR_";.28//"_$$SDT^ABMDUTL($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0),U,14))
  1.  .S DR=DR_";.03Units (at $"_ABMZ("PPDU")_" per unit);.04///"_ABMZ("PPDU")
  1.  .D ^DIE Q:$D(Y)
  1.  .S DR=".17///M" D ^DIE
  1.  .S ABM("X0")=^ABMDCLM(DUZ(2),DA(1),23,DA,0)
  1.  .D DFEE S DR=".16Times Dispensed (at $"_ABMZ("DISPFEE")_" per each time dispensed) //1"
  1.  .D ^DIE Q:$D(Y)
  1.  .S DR=".05///"_(ABMZ("DISPFEE")*X) D ^DIE
  1.  .S DR=".2;.06;.22////@;.19Refill"
  1.  .S DR=DR_";.24//"_$S($P($G(^PSDRUG(+ABM("X0"),2)),U,4)]"":$P(^(2),U,4),1:"")
  1.  .S DR=DR_";.25"
  1.  .S DR=DR_";.29//"  ;CPT code  ;abm*2.6*7 HEAT30524
  1.  .D ^DIE
  1.  .D NARR  ;abm*2.6*19 IHS/SD/SDR HEAT173117
  1.  .D PROV
  1.  .;
  1.  I (^ABMDEXP(ABMMODE(4),0)["HCFA")!(^ABMDEXP(ABMMODE(4),0)["CMS") D
  1.  .D DX^ABMDEMLC S DR=".13////"_$G(Y(0)) D ^DIE
  1.  .S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
  1.  Q
  1.  ;
  1.  ;start new abm*2.6*19 IHS/SD/SDR HEAT173117 NARR
  1. NARR ;
  1.  I (+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0)),U,29)'=0) D
  1.  .I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0)),U,29))) D
  1.  ..Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"  ;only 5010 formats
  1.  ..S ABMCNCK=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,DA,0)),U,29),0))
  1.  ..I ABMCNCK,$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMCNCK,0)),U,2)="Y" S DR="22Narrative" D ^DIE
  1.  Q
  1.  ;end new abm*2.6*19 IHS/SD/SDR HEAT173117 NARR
  1.  ;
  1. PPDU ;PRICE PER DISPENSE UNIT
  1.  S DR=""
  1.  S:^ABMDEXP(ABMMODE(4),0)["UB" DR=".02//250;"
  1.  ;S ABMZ("PPDU")=+$P($G(^ABMDFEE(ABMP("FEE"),25,ABMZ("DRUG"),0)),U,2)  ;abm*2.6*2 3PMS10003A
  1.  S ABMZ("PPDU")=+$P($$ONE^ABMFEAPI(ABMP("FEE"),25,ABMZ("DRUG"),ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A
  1.  S:'ABMZ("PPDU") ABMZ("PPDU")=+$P($G(^PSDRUG(ABMZ("DRUG"),660)),U,6)
  1.  S DIR(0)="Y",DIR("A")="Is this entry an IV"
  1.  S DIR("B")=$S($P(^ABMDCLM(DUZ(2),DA(1),23,DA,0),"^",15)'="":"YES",1:"NO")
  1.  D ^DIR K DIR S ABMZ("IV")=Y I Y=1 D
  1.  .S DIR(0)="N^0:9999:3",DIR("B")=ABMZ("PPDU"),DIR("A")="IV Price per Unit"
  1.  .I $P(^ABMDCLM(DUZ(2),DA(1),23,DA,0),U,4) S DIR("B")=$P(^(0),U,4)
  1.  .D ^DIR K DIR S ABMZ("PPDU")=Y
  1.  .S DR=".02//IV;.15;.07;.08;.09;"
  1.  Q
  1. DFEE ;GET DISPENSE FEE
  1.  S ABMZ("DISPFEE")=0
  1.  I ABMP("VTYP")'=111,ABMP("VTYP")'=831 S ABMZ("DISPFEE")=$P($G(^ABMDPARM(DUZ(2),1,0)),U,3) Q
  1.  I $P($G(ABM("X0")),U,15)="" S ABMZ("DISPFEE")=$P($G(^ABMDPARM(DUZ(2),1,4)),U,6) Q
  1.  S ABMZ("DISPFEE")=$P($G(^ABMDPARM(DUZ(2),1,4)),U,$F("APHSC",$P(ABM("X0"),U,15))-1)
  1.  Q
  1. PROV ;
  1.  N DIC,DR,DIE
  1.  S DA(2)=ABMP("CDFN")
  1.  S (DA(1),ABMSIEN)=DA
  1.  S DIC="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
  1.  S DIC(0)="AELMQ"
  1.  S ABMFLNM="9002274.30"_$G(ABMZ("SUB"))
  1.  S DIC("P")=$P(^DD(ABMFLNM,.18,0),U,2)
  1.  S DIC("DR")=".01;.02//R"
  1.  D ^DIC
  1.  K DIC,DR,DIE
  1.  I +Y>0,(+$P(Y,U,3)=0) D
  1.  .K DIE,DA,DR
  1.  .S DA(2)=ABMP("CDFN")
  1.  .S DA(1)=ABMSIEN
  1.  .S DIE="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
  1.  .S DA=+Y
  1.  .S DR=".01//;.02"
  1.  .D ^DIE
  1.  S DA=+$G(DA(1))
  1.  S DA(1)=ABMP("CDFN")
  1.  Q