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

ABSPOSRS.m

Go to the documentation of this file. 
  1. ABSPOSRS ; IHS/OIT/CNI/SCR - TM Audit report
  1.  ;;1.0;PHARMACY POINT OF SALE;**39,40,41**;JUN 21, 2001;Build 38
  1.  ;
  1.  ;This is to do a report based on fields being audited.
  1.  ;They are listed below under FILES tag.  To add new fields
  1.  ;to report just list them under FILES and turn the audit on
  1.  ;using FM.
  1.  ;
  1.  ;K ABM,ABMY
  1.  ;
  1. SEL  ;EP FOR POS PARAMATER AUDIT TRAIL REPORT
  1.  N ABSP,ABSPY,ABSPQ
  1.  S ABSP("RTYP")=1
  1.  S ABSP("RTYP","NM")="AUDIT LISTING"
  1.  D LOOP Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  S ABSP("HD",0)="LISTING of Audited fields "
  1.  S ABSP("LVL")=0
  1.  ;S ABSPQ("RC")="COMPUTE^ABSPOSRS",ABMQ("RX")="POUT^ABSPOSRS",ABMQ("NS")="ABSP"
  1.  S ABSPQ("RC")="COMPUTE^ABSPOSRS",ABSPQ("RX")="POUT^ABSPOSRS",ABSPQ("NS")="ABSP" ;IHS/OIT/CNI/SCR 083010 patch 40
  1.  S ABSPQ("RP")="OUTPUT^ABSPOSRS"
  1.  D SET^ABSPOSUQ(.ABSPQ)
  1.  Q
  1.  ;
  1. FILES ;These fields must be 'audited' at the site to show up on this report
  1.  ;;9002313.56;.01;Name
  1.  ;;9002313.56;.06;ENVOY TERMINAL ID
  1.  ;;9002313.56;.02;NCPDP #
  1.  ;;9002313.56;.03;DEFAULT DEA #
  1.  ;;9002313.56;3001.01;MEDICAID #
  1.  ;;9002313.56;3001.02;DEFAULT CAID PROVIDER #
  1.  ;;9002313.56;115;AUTOPRINT PHARMACY EXPENSE RPT
  1.  ;;9002313.56;115.01;DEFAULT DEVICE
  1.  ;;9002313.56;950,.01;INSURER
  1.  ;;9002313.56;950,.02;INSURER-ASSIGNED #
  1.  ;;9002313.56;950,.03;MED-CAL SUBSCRIBER ID
  1.  ;;9002313.56;950,.04;CA FAMILY PACT ID
  1.  ;;9002313.55;.01;NAME
  1.  ;;9002313.55;450.01;PHONE NUMBER
  1.  ;;9002313.55;.03;SWITCH TYPE
  1.  ;;9002313.55;.02;MODEM TYPE
  1.  ;;9002313.55;208;BAUD RATE
  1.  ;;9002313.55;420.02;CONNECTION TYPE
  1.  ;;9002313.55;420.03;CACHE DEVICE #
  1.  ;;9002313.55;2021.01;IP ADDRESS
  1.  ;;9002313.55;2021.02;TCP PORT NUMBER
  1.  ;;9002313.55;1660.01;ETB
  1.  ;;9002313.4;.01;NAME
  1.  ;;9002313.4;100.01;RX - NCPDP Record Format
  1.  ;;9002313.4;100.14;INSURER NPI FLAG
  1.  ;;9002313.4;100.07;RX - DIAL OUT TO
  1.  ;;9002313.4;100.06;RX - PRICING METHOD
  1.  ;;9002313.4;100.02;RX - Dispensing Fee
  1.  ;;9002313.4;100.08;GRACE PERIOD
  1.  ;;9002313.4;100.05;RX - Help Telephone #
  1.  ;;9002313.4;104.01;RX PRIORITY
  1.  ;;9002313.4;107.01;WORKERS COMP INSURANCE
  1.  ;;9002313.4;228.11,.01;BILLABLE NDC #
  1.  ;;9002313.4;2128.11,.01;UNBILLABLE NDC #
  1.  ;;9002313.4;2128.13;UNBILLABLE OTC
  1.  ;;9002313.53;.01;NAME
  1.  ;;9002313.53;.02;UNIT PRICE SOURCE
  1.  ;;9002313.53;.04; MULTIPLIER
  1.  ;;9002313.53;.05;DISPENSING FEE
  1.  ;;9002313.99;943;USUAL INPUT METHOD
  1.  ;;9002313.99;440.01;DEFAULT DIAL OUT
  1.  ;;9002313.99;1501;OUTSIDE LINE
  1.  ;;9002313.99;170.01;A/R PACKAGE
  1.  ;;9002313.99;170.02;SEND 3PB REJECT 
  1.  ;;9002313.99;2128.13;OTC DRUGS ARE UNBILLABLE
  1.  ;;9002313.99;2128.11,.01;NAME
  1.  ;;9002313.99;1960.01;OK MEDICAID INSURANCE NAME
  1.  ;;9002313.99;1960.03;OK MEDICAID LIMIT
  1.  ;;9002313.99;1960.02;OK MEDICAID CYCLE
  1.  ;;9002313.99;960.01;INS BASE PRVT
  1.  ;;9002313.99;960.02;INS BASE CARE
  1.  ;;9002313.99;960.03;INS BASE CAID
  1.  ;;9002313.99;960.04; INS BASE RR
  1.  ;;9002313.99;960.05; INS BASE SELF
  1.  ;;9002313.99;970.01,.01;INS RULE ORDER
  1.  ;;9002313.99;970.01,.02;INS RULE NAME
  1.  ;;9002313.99;970.01,.03;INS RULE POINTS PLUS
  1.  ;;9002313.99;970.01,.04;INS RULE POINTS MINUS
  1.  ;;9002313.99;6000;GLOBAL NPI FLAG 
  1.  ;;END
  1. LOOP ;
  1.  ; Display current exclusion parameters
  1.  ;S ABMY("X")="W $$SDT^ABMDUTL(X)"
  1.  S ABSPY("X")="W $$FM2EXT^ABSPOSU1(X)"
  1.  ;G XIT:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
  1.  I $D(DTOUT)!$D(DIROUT) D XIT Q
  1.  W !!?3,"EXCLUSION PARAMETERS Currently in Effect for RESTRICTING the EXPORT to:",!?3,"======================================================================="
  1.  ;I $D(ABSPY("LOC")) W !?3,"- Pharmacy.....: ",$P(^DIC(4,ABSPY("LOC"),0),"^",1)
  1.  ;IHS/OIT/CASSEVERN/RAN - 12/30/2010 - Patch 41 Changed to point to PHARMACY FILE...not INSTITUTION file.
  1.  I $D(ABSPY("LOC")) W !?3,"- Pharmacy.....: ",$P(^ABSP(9002313.56,ABSPY("LOC"),0),"^",1)
  1.  I $D(ABSPY("DT")) W !?3,"- Edit Date Range....:"
  1.  I  S X=ABSPY("DT",1) X ABSPY("X") W "  to: " S X=ABSPY("DT",2) X ABSPY("X")
  1.  ; Choose additional exclusion parameters
  1.  N DIR
  1.  S DIR(0)="SO^1:PHARMACY;2:DATE RANGE"
  1.  S DIR("A")="Select ONE or MORE of the above EXCLUSION PARAMETERS"
  1.  S DIR("?")="The report can be restricted to one or more of the listed parameters. A parameter can be removed by reselecting it and making a null entry."
  1.  D ^DIR
  1.  ;G XIT:$D(DIRUT)!$D(DIROUT)
  1.  I $D(DTOUT)!$D(DIROUT) D XIT Q
  1.  I Y=1!(Y=2) D @($S(Y=1:"LOC",1:"DT")_"^ABSPOSRS") D LOOP
  1.  ;
  1. COMPUTE ;
  1.  S ABSP("SUBR")="ABSPOSRS"
  1.  K ^TMP($J,"ABSPOSRS")
  1.  F ABSPCNT=1:1 S ABSPSEL=$P($T(FILES+ABSPCNT),";;",2) Q:ABSPSEL="END"  D
  1.  .S ABSPFILE=$P(ABSPSEL,";")
  1.  .S ABSPFLD=$P(ABSPSEL,";",2)
  1.  .S ABSPFNAM=$P(ABSPSEL,";",3)
  1.  .I $G(ABSPY("DT",1))'="" S ABSPSDT=($G(ABSPY("DT",1))-1),ABSPEDT=$G(ABSPY("DT",2))+1
  1.  .E  S ABSPSDT=0,ABSPEDT=9999999
  1.  .F  S ABSPSDT=$O(^DIA(ABSPFILE,"C",ABSPSDT)) Q:+ABSPSDT=0!(ABSPSDT>ABSPEDT)  D
  1.  ..S ABSPAIEN=0
  1.  ..F  S ABSPAIEN=$O(^DIA(ABSPFILE,"C",ABSPSDT,ABSPAIEN)) Q:+ABSPAIEN=0  D
  1.  ...Q:$P($G(^DIA(ABSPFILE,ABSPAIEN,0)),U,3)'=ABSPFLD  ;quit if not Printable Name of Payment Site
  1.  ...S ABSPUSER=$P($G(^DIA(ABSPFILE,ABSPAIEN,0)),U,4)
  1.  ...S ABSPOLD=$P($G(^DIA(ABSPFILE,ABSPAIEN,2)),U)
  1.  ...S ABSPNEW=$P($G(^DIA(ABSPFILE,ABSPAIEN,3)),U)
  1.  ...S ^TMP($J,"ABSPOSRS",ABSPFILE,ABSPFLD,ABSPFNAM,ABSPSDT,ABSPUSER)=ABSPOLD_"^"_ABSPNEW
  1.  Q
  1. OUTPUT ;
  1.  D HDB
  1.  N ABSPFNAM,ABSPFILE,ABSPADT,ABSPUSER,ABSPFLD,ABSPOLD,ABSPNEW
  1.  S (ABSPADT,ABSPUSER,ABSPFILE,ABSPFLD,ABSPOLD,ABSPNEW)=0
  1.  F  S ABSPFILE=$O(^TMP($J,"ABSPOSRS",ABSPFILE)) Q:+ABSPFILE=0  D   Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  .S ABSPFLD=0,ABSPSFLD=0
  1.  .F  S ABSPFLD=$O(^TMP($J,"ABSPOSRS",ABSPFILE,ABSPFLD)) Q:+ABSPFLD=0  D   Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  ..S ABSPSDT=0
  1.  ..S ABSPFNAM=""
  1.  ..S ABSPFNAM=$O(^TMP($J,"ABSPOSRS",ABSPFILE,ABSPFLD,ABSPFNAM))
  1.  ..I ABSPFLD'=ABSPSFLD D
  1.  ...;W !!?5,$P($G(^DIC(ABSPFILE,0)),U)_"  Fld: "_$P($G(^DD(ABSPFILE,+ABSPFLD,0)),U)
  1.  ...W !!?5,$P($G(^DIC(ABSPFILE,0)),U)_"  Fld: "_ABSPFNAM
  1.  ..S ABSPSFLD=ABSPFLD
  1.  ..F  S ABSPSDT=$O(^TMP($J,"ABSPOSRS",ABSPFILE,ABSPFLD,ABSPFNAM,ABSPSDT)) Q:+ABSPSDT=0  D   Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  ...S ABSPUSER=0
  1.  ...F  S ABSPUSER=$O(^TMP($J,"ABSPOSRS",ABSPFILE,ABSPFLD,ABSPFNAM,ABSPSDT,ABSPUSER)) Q:+ABSPUSER=0  D   Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  ....I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)  W " (cont)"
  1.  ....W !,$$FM2EXT^ABSPOSU1(ABSPSDT) ;date/time external format
  1.  ....W ?22,$E($P($G(^VA(200,ABSPUSER,0)),U),1,17)  ;user
  1.  ....W ?42,$E($P($G(^TMP($J,"ABSPOSRS",ABSPFILE,ABSPFLD,ABSPFNAM,ABSPSDT,ABSPUSER)),U),1,20) ;old value
  1.  ....W ?64,$E($P($G(^TMP($J,"ABSPOSRS",ABSPFILE,ABSPFLD,ABSPFNAM,ABSPSDT,ABSPUSER)),U,2),1,20)  ;new value
  1.  K ^TMP($J,"ABSPOSRS")
  1.  Q
  1. LOC ;EP
  1.  W !
  1.  N DIC
  1.  S DIC="^ABSP(9002313.56,"
  1.  S DIC(0)="AEMQ"
  1.  S DIC("A")="Select PHARMACY: "
  1.  D ^DIC K DIC
  1.  Q:+Y<1
  1.  S ABSPY("LOC")=+Y
  1.  Q
  1. DT ;EP
  1.  K DIR,ABSPY("DT")
  1.  Q:$D(DIRUT)
  1.  S ABSPY("DT")="E"
  1.  S Y="EDIT DATE"
  1.  W !!," ============ Entry of ",Y," Range =============",!
  1.  S DIR("A")="Enter STARTING "_Y_" for the Report"
  1.  S DIR(0)="DO^::EP"
  1.  D ^DIR
  1.  G DT:$D(DIRUT)
  1.  S ABSPY("DT",1)=Y
  1.  W !
  1.  S DIR("A")="Enter ENDING DATE for the Report"
  1.  D ^DIR
  1.  K DIR
  1.  G DT:$D(DIRUT)
  1.  S ABSPY("DT",2)=Y
  1.  I ABSPY("DT",1)>ABSPY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! G DT
  1.  Q
  1. XIT ;
  1.  K ABSPY("I"),ABSPY("X"),DIR
  1.  Q
  1. HDR ;
  1.  I $D(ABSPY("LOC")) S ABSP("TXT")=$P(^DIC(4,ABSPY("LOC"),0),U),ABSPM("CONJ")="at " D CHK
  1.  Q:$G(ABSPY("DT",1))=""  ;no dates
  1.  S ABSP("CONJ")="with "
  1.  S ABSP("TXT")="Edit Date" D CHK
  1.  S ABSP("CONJ")="from ",ABSP("TXT")=$$FM2EXT^ABSPOSU1(ABSPY("DT",1)) D CHK
  1.  S ABSP("CONJ")="to ",ABSP("TXT")=$$FM2EXT^ABSPOSU1(ABSPY("DT",2)) D CHK
  1.  Q
  1. WHD ;EP for writing Report Header
  1.  W $$EN^ABMVDF("IOF"),!
  1.  N ABSPLINE
  1.  S $P(ABSPLINE,"=",$S($D(ABSP(132)):132,1:80))="" W ABSPLINE,!
  1.  W ABSP("HD",0),?$S($D(ABSP(132)):108,1:57) S Y=DT X ^DD("DD") W Y,"   Page ",ABSP("PG")
  1.  W:$G(ABSP("HD",1))]"" !,ABSP("HD",1)
  1.  W:$G(ABSP("HD",2))]"" !,ABSP("HD",2)
  1.  W !,ABSPLINE
  1.  Q
  1. CHK I ($L(ABSP("HD",ABSP("LVL")))+1+$L(ABSP("CONJ"))+$L(ABSP("TXT")))<($S($D(ABSP(132)):104,1:52)+$S(ABM("LVL")>0:28,1:0)) S ABM("HD",ABM("LVL"))=ABM("HD",ABM("LVL"))_" "_ABM("CONJ")_ABM("TXT")
  1.  E  S ABSP("LVL")=ABSP("LVL")+1,ABSP("HD",ABM("LVL"))=ABSP("CONJ")_ABSP("TXT")
  1.  Q
  1. HD ;
  1.  I '$D(IO("Q")),$E(IOST)="C",'$D(IO("S")) D
  1.  .F  W ! Q:$Y+3>IOSL!($D(DTOUT)!($D(DUOUT)!$D(DIROUT)))
  1.  .N DIR S DIR(0)="E" D ^DIR
  1. HDB S ABSP("PG")=+$G(ABSP("PG"))+1 D WHD
  1.  N ABSPLINE
  1.  W !,"Date/Time",?17,"User",?35,"Old Value",?58,"New Value"
  1.  S $P(ABSPLINE,"-",80)="" W !,ABSPLINE
  1.  Q
  1. POUT ;EP for exiting report
  1.  K ^TMP($J,"ABSPOSRS")
  1.  D KILL^%ZTLOAD
  1.  K ABSPY,ABSPP,ABSP,IO("Q"),POP,DIR,DUOUT,DTOUT,ZTSK,DIROUT,DIRUT,%ZIS
  1.  Q