PSODEAMA ;DAL/JCH - Manually Entered DEA Report ;08/16/2021
;;7.0;OUTPATIENT PHARMACY;**545,731**;DEC 1997;Build 18
;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
;External reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
;
Q
;
ENTRY ; Entry Point
;
N PSODONE,PSOHEAD,PSORTYPE
S PSODONE=0,PSOHEAD="Manually Entered DEA Report"
D MESSAGE
D ASK(.PSORTYPE,.PSODONE) Q:$G(PSODONE)
D DEVICE(.PSODONE) Q:PSODONE ; Print to device
D PROCESS
Q
;
PROCESS ; Process and Print Report Data
D RUN
D OUT
D CLOSE
D EXIT
Q
;
MESSAGE ; Option informatoin
;
W !!,"This option lists DEA numbers that were added/edited via the Manual DEA Number"
W !,"Entry [PSO EPCS DEA MANUAL ENTRY] option and were not subsequently updated"
W !,"using the Add New Providers [PSO PROVIDER ADD] option or the Edit Provider"
W !,"[PSO PROVIDER EDIT] option while the PSO DOJ/DEA WEB SERVICE was running."
W !!,"Manually entered DEA numbers are removed from this list after they are edited"
W !,"using the Add New Providers [PSO PROVIDER ADD] option or the Edit Provider"
W !,"[PSO PROVIDER EDIT] option while the PSO DOJ/DEA WEB SERVICE is running."
Q
;
ASK(PSORTYPE,PSODONE) ; Ask user's report options
; Summary or Detailed Report
N DIR,X,Y
S DIR(0)="S^S:Summary;D:Detailed",DIR("A")="Report Type" D ^DIR K DIR I $D(DIRUT) S PSODONE=1 Q
S PSORTYPE=Y,PSOHEAD=PSOHEAD_$S(Y="S":"(Summary)",1:"(Detailed)")
Q
;
RUN ; Run Report
N DEATXT,PSOLINE,WSDWN
S PSOLINE=1,WSDWN=0
D GATHER
S DEATXT="" F S DEATXT=$O(^TMP($J,"PSODEAMA","DEA",DEATXT)) Q:DEATXT="" D
.N IEN,IENS,WSAR,MANAR
.S IEN=+$G(^TMP($J,"PSODEAMA","DEA",DEATXT)),IENS=IEN_","
.D GETMAN(IENS,.MANAR)
.I DEATXT'="" D GETWS(DEATXT,.WSAR,.WSDWN)
.D COMPILE(.MANAR,.WSAR,.PSOLINE,PSORTYPE)
Q PSODONE
;
GATHER ; Identify Manually entered DEA #'s
N DEAIEN,DEATXT,PSODONE S PSODONE=0
K ^TMP($J,"PSODEAMA")
S DEAIEN=0 F S DEAIEN=$O(^XTV(8991.9,DEAIEN)) Q:'DEAIEN!$G(PSODONE) D
.N RETURN,ERROR,FIELDS,DOJUPDT,IENS,MANAR,WSAR,DEATXT,WSDWN
.S IENS=DEAIEN_","
.Q:$$GET1^DIQ(8991.9,IENS,10.3,"I") ; Quit if Last Updated by PSO DOJ/DEA WEB SERVICE
.S DEATXT=$$GET1^DIQ(8991.9,IENS,.01,"E")
.S ^TMP($J,"PSODEAMA","DEA",DEATXT)=DEAIEN
Q
;
GETMAN(IENS,MANAR) ; Get one manually entered DEA number from DEA NUMBERS file (#8991.9)
N TMPAR
;S FIELDS=".01;.02;.03;.04;.05;.06;.07;1.1;1.2;1.3;1.4;1.5;1.6;1.7;2.1;2.2;2.3;2.4;2.5;2.6;10.1;10.2;10.3" ;P731 detox/x-waiver removal
S FIELDS=".01;.02;.04;.05;.06;.07;1.1;1.2;1.3;1.4;1.5;1.6;1.7;2.1;2.2;2.3;2.4;2.5;2.6;10.1;10.2;10.3"
D GETS^DIQ(8991.9,IENS,FIELDS,,"MANAR","ERROR")
M TMPAR=MANAR(8991.9,IENS) K MANAR M MANAR=TMPAR
Q
;
GETWS(DEATXT,WSAR,WSDWN) ; Get one DEA#'s information from Web Service
N RETURN,NOMORE,FLD,TXTLN
S NOMORE=0
I '$G(WSDWN) S RETURN=$$WSGET^PSODEAUT(.WSAR,DEATXT)
S RETURN=$G(RETURN)
I $P(RETURN,U,3)=6059 S WSDWN=1 ; Web Service Down
I (RETURN["DEA NUMBER NOT FOUND")!$G(WSDWN) D Q
.F TXTLN=1:1:999 Q:NOMORE S FLD=$P($T(JSONFLDS+TXTLN),";",2) D
..I FLD="***" S NOMORE=1 Q
..I FLD="deaNumber" S WSAR(FLD)=$S($G(WSDWN):"Unable to Connect",1:"Not Found") Q
..S WSAR(FLD)="**"
Q
;
COMPILE(MANAR,WSAR,PSOLINE,PSORTYPE) ; Print results
N DS,DSII,DSIIN,DSIII,DSIIIN,DSIV,DSV,COL1IN,COL2IN,PSEXPDTE,PSDTRSLT,BAC,PSDTXDOJ,PSTYPE
N PRNAM,PRNO,PRNOCONTXT,XIP
S COL1IN=20,COL2IN=21
;
S ^TMP($J,"PSODEAMA","OUT",PSOLINE)="",PSOLINE=PSOLINE+1
S PRNOCONTXT="Unable to Connect"
;
S PRNO=$$ASSIGNED(MANAR(.01))
S ^TMP($J,"PSODEAMA","OUT",PSOLINE)="DEA Number "_MANAR(.01)_$S(PRNO:" assigned to "_$P(PRNO,U,2)_" (IEN: "_+PRNO_")",1:" not assigned to any providers.")
S PSOLINE=PSOLINE+1
;
Q:$G(PSORTYPE)="S"
;
S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("FIELD NAME",COL1IN)_$$LJ^XLFSTR("DOJ VALUE",COL2IN)_"LOCAL VISTA VALUE (Manual)"
S PSOLINE=PSOLINE+1
S $P(^TMP($J,"PSODEAMA","OUT",PSOLINE),"-",75)="-"
S PSOLINE=PSOLINE+1
S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("DEA NUMBER: ",COL1IN)_$$LJ^XLFSTR(WSAR("deaNumber"),COL2IN)_MANAR(.01)
S PSOLINE=PSOLINE+1
I WSAR("name")'=MANAR(1.1) D
.I $G(WSDWN) S WSAR("name")=PRNOCONTXT Q
. S:$E(WSAR("name"),$L(WSAR("name")))'="*" WSAR("name")=WSAR("name")_"**"
S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("NAME: ",COL1IN)_$$LJ^XLFSTR(WSAR("name"),COL2IN)_MANAR(1.1)
S PSOLINE=PSOLINE+1
;
I $$NULLCHK(WSAR("address1"),MANAR(1.2)) D
. I WSAR("address1")'=MANAR(1.2) D
.. I $G(WSDWN) S WSAR("address1")=PRNOCONTXT Q
.. S:WSAR("address1")'="**" WSAR("address1")=WSAR("address1")_"**"
. S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ADDRESS 1:",COL1IN)_$$LJ^XLFSTR(WSAR("address1"),COL2IN)_MANAR(1.2)
. S PSOLINE=PSOLINE+1
;
I $$NULLCHK(WSAR("address2"),MANAR(1.3)) D
.I WSAR("address2")'=MANAR(1.3) D
.. I $G(WSDWN) S WSAR("address2")=PRNOCONTXT Q
.. S:WSAR("address2")'="**" WSAR("address2")=WSAR("address2")_"**"
.S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ADDRESS 2:",COL1IN)_$$LJ^XLFSTR(WSAR("address2"),COL2IN)_MANAR(1.3)
.S PSOLINE=PSOLINE+1
;;
;I $$NULLCHK(WSAR("address3"),MANAR(1.4)) D
;.I WSAR("address3")'=MANAR(1.4) S:WSAR("address3")'="**" WSAR("address3")=WSAR("address3")_"**"
;.S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ADDRESS 3:",COL1IN)_$$LJ^XLFSTR(WSAR("address3"),COL2IN)_MANAR(1.4)
;.S PSOLINE=PSOLINE+1
;
I $$NULLCHK(WSAR("city"),MANAR(1.5)) D
. I WSAR("city")'=MANAR(1.5) D
.. I $G(WSDWN) S WSAR("city")=PRNOCONTXT Q
.. S:WSAR("city")'="**" WSAR("city")=WSAR("city")_"**"
. S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("CITY:",COL1IN)_$$LJ^XLFSTR(WSAR("city"),COL2IN)_MANAR(1.5)
. S PSOLINE=PSOLINE+1
;
I $$NULLCHK(WSAR("state"),MANAR(1.6)) D
. D POSTAL^XIPUTIL($G(WSAR("zipCode")),.XIP) S XSTATE=$G(XIP("STATE"))
. I XSTATE'=MANAR(1.6) D
.. I $G(WSDWN) S XSTATE=PRNOCONTXT Q
.. S:XSTATE'="**" XSTATE=XSTATE_"**"
. S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("STATE:",COL1IN)_$$LJ^XLFSTR(XSTATE,COL2IN)_MANAR(1.6)
. S PSOLINE=PSOLINE+1
;
I $$NULLCHK(WSAR("zipCode"),MANAR(1.7)) D
. I WSAR("zipCode")'=MANAR(1.7) D
.. I $G(WSDWN) S WSAR("zipCode")=PRNOCONTXT Q
.. S:WSAR("zipCode")'="**" WSAR("zipCode")=WSAR("zipCode")_"**"
. S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ZIP:",COL1IN)_$$LJ^XLFSTR(WSAR("zipCode"),COL2IN)_MANAR(1.7)
. S PSOLINE=PSOLINE+1
;
S BAC=$S($G(WSAR("businessActivityCode"))="**":"",1:$G(WSAR("businessActivityCode")))_$S($G(WSAR("businessActivitySubcode"))="**":"",1:$G(WSAR("businessActivitySubcode")))
S DEA=WSAR("deaNumber"),PSDTXDOJ=""
I BAC?1U S BAC=BAC_0
I BAC'=MANAR(.02) D
. I $G(WSDWN) S BAC=PRNOCONTXT Q
. S:BAC'="**" BAC=BAC_"**"
I $$NULLCHK(BAC,MANAR(.02)) D
. S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ACTIVITY CODE:",COL1IN)_$$LJ^XLFSTR(BAC,COL2IN)_MANAR(.02)
. S PSOLINE=PSOLINE+1
;
S PSTYPE=BAC I $TR(PSTYPE,"*")'="" S PSTYPE=$P($$PROVTYPE^PSODEAUT(PSTYPE),"^",2)
I $$NULLCHK(WSAR("businessActivityCode"),MANAR(.07)) D
. I $G(WSDWN) S PSTYPE=PRNOCONTXT
. I '$G(WSDWN),(PSTYPE'=MANAR(.07)) S:$E(PSTYPE,$L(PSTYPE))'="*" PSTYPE=PSTYPE_"**"
. S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("TYPE:",COL1IN)_$$LJ^XLFSTR(PSTYPE,COL2IN)_MANAR(.07)
. S PSOLINE=PSOLINE+1
;
;P731 detox/x-waiver removal
;S BAC=$G(WSAR("businessActivityCode"))_WSAR("businessActivitySubcode")
;I $$NULLCHK(BAC,DEA) S PSDTXDOJ=$S($$DETOXCHK^PSODEAUT(BAC):"X"_$E(MANAR(.01),2,9),1:"")
;I $$NULLCHK(PSDTXDOJ,MANAR(.03)) D
;. I $G(WSDWN) S PSDTXDOJ=PRNOCONTXT
;. I '$G(WSDWN),(PSDTXDOJ'=MANAR(.03)) S:$E(PSDTXDOJ,$L(PSDTXDOJ))'="*" PSDTXDOJ=PSDTXDOJ_"**"
;. S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("DETOX NUMBER:",COL1IN)_$$LJ^XLFSTR(PSDTXDOJ,COL2IN)_MANAR(.03)
;. S PSOLINE=PSOLINE+1
;
S (PSDTRSLT,PSDTRSLT(0))=""
I $$NULLCHK(WSAR("expirationDate"),MANAR(.04)) D DT^DILF("E",$G(WSAR("expirationDate")),.PSDTRSLT)
I $G(WSDWN) S PSDTRSLT(0)=PRNOCONTXT
I '$G(WSDWN),(PSDTRSLT(0)'=MANAR(.04)) S:PSDTRSLT(0)'="**" PSDTRSLT(0)=PSDTRSLT(0)_"**"
S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("EXPIRATION DATE:",COL1IN)_$$LJ^XLFSTR($G(PSDTRSLT(0)),COL2IN)_MANAR(.04)
S PSOLINE=PSOLINE+1
;
S DS=WSAR("drugSchedule")
;
I $$NULLCHK(DS,MANAR(2.1)) D
.I $G(WSDWN) S DSII=PRNOCONTXT
.I '$G(WSDWN) D
.. S DSII=$S(DS["22N":"YES",(DS["2"&(DS'["2N")):"YES",DS="**":"",1:"NO")
.. S DSII=$G(DSII)_$S($G(DSII)'=$G(MANAR(2.1)):"**",1:"")
.S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH II NARC:",COL1IN)_$$LJ^XLFSTR(DSII,COL2IN)_MANAR(2.1)
.S PSOLINE=PSOLINE+1
;
I $$NULLCHK(DS,MANAR(2.2)) D
.I $G(WSDWN) S DSIIN=PRNOCONTXT
.I '$G(WSDWN) D
.. S DSIIN=$S(DS["2N":"YES",DS="**":"",1:"NO")
.. S DSIIN=DSIIN_$S(DSIIN'=$G(MANAR(2.2)):"**",1:"")
.S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH II NON-NARC:",COL1IN)_$$LJ^XLFSTR(DSIIN,COL2IN)_MANAR(2.2)
.S PSOLINE=PSOLINE+1
;
I $$NULLCHK(DS,MANAR(2.3)) D
.I $G(WSDWN) S DSIII=PRNOCONTXT
.I '$G(WSDWN) D
.. S DSIII=$S(DS="**":"",DS["33N":"YES",DS["3"&(DS'["3N"):"YES",1:"NO")
.. S DSIII=DSIII_$S(DSIII'=$G(MANAR(2.3)):"**",1:"")
.S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH III NARC:",COL1IN)_$$LJ^XLFSTR(DSIII,COL2IN)_MANAR(2.3)
.S PSOLINE=PSOLINE+1
;
I $$NULLCHK(DS,MANAR(2.4)) D
.I $G(WSDWN) S DSIIIN=PRNOCONTXT
.I '$G(WSDWN) D
.. S DSIIIN=$S(DS="**":"",DS["3N":"YES",1:"NO")
.. S DSIIIN=DSIIIN_$S(DSIIIN'=$G(MANAR(2.4)):"**",1:"")
.S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH III NON-NARC:",COL1IN)_$$LJ^XLFSTR(DSIIIN,COL2IN)_MANAR(2.4)
.S PSOLINE=PSOLINE+1
;
I $$NULLCHK(DS,MANAR(2.5)) D
.I $G(WSDWN) S DSIV=PRNOCONTXT
.I '$G(WSDWN) D
.. S DSIV=$S(DS="**":"",DS["4":"YES",1:"NO")
.. S DSIV=DSIV_$S(DSIV'=$G(MANAR(2.5)):"**",1:"")
.S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH IV:",COL1IN)_$$LJ^XLFSTR(DSIV,COL2IN)_MANAR(2.5)
.S PSOLINE=PSOLINE+1
;
I $$NULLCHK(DS,MANAR(2.6)) D
.I $G(WSDWN) S DSV=PRNOCONTXT
.I '$G(WSDWN) D
.. S DSV=$S(DS="**":"",DS["5":"YES",1:"NO") ; SCHEDULE V
.. S DSV=DSV_$S(DSV'=$G(MANAR(2.6)):"**",1:"")
.S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH V:",COL1IN)_$$LJ^XLFSTR(DSV,COL2IN)_MANAR(2.6)
.S PSOLINE=PSOLINE+1
;
Q
;
OUT ; Write Output
N PSOLINE,PSOPAGE,DIR,Y,PSODONE,PSOQ
S PSOLINE=0,PSOPAGE=1
I $D(IO("Q")) D CLEAR^VALM1
U IO
F S PSOLINE=$O(^TMP($J,"PSODEAMA","OUT",PSOLINE)) Q:'PSOLINE!$G(PSODONE) D
. I PSOLINE>1 D
.. I ($G(PSORTYPE)'="S") I ^TMP($J,"PSODEAMA","OUT",PSOLINE)="" D Q:$G(PSODONE)
... S PSODONE=$$CHKP(.PSOPAGE,PSOHEAD,PSORTYPE) Q:$G(PSODONE)
.. I $G(PSORTYPE)="S" S PSODONE=$$CHKP(.PSOPAGE,PSOHEAD,PSORTYPE) Q:$G(PSODONE)
. I PSOLINE=1 D HDR(.PSOPAGE,PSOHEAD,PSORTYPE)
. W !,^TMP($J,"PSODEAMA","OUT",PSOLINE)
I '$G(PSODONE) S PSODONE=$$CHKP(0)
Q
;
DEVICE(PSODONE) ; Request Device Information
N %ZIS,IOP,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP,RTN,VAR
K IO("Q")
S %ZIS="QM"
W ! D ^%ZIS I POP S PSODONE=1 Q
I $D(IO("Q")) D
. S RTN=$P($T(+1)," ",1)
. S ZTRTN="PROCESS^PSODEAMA"
. S ZTIO=ION
. S ZTSAVE("PS*")=""
. S ZTDESC="MANUAL DEA ENTRY REPORT"
. D ^%ZTLOAD W !,$S($D(ZTSK):"Report is Queued to print (Task "_ZTSK_")",1:"REQUEST CANCELLED") K ZTSK
. S PSODONE=1
Q
;
NULLCHK(DOJVAL,VISTAVAL) ; Check for null value, filter out askterisks
I $TR(DOJVAL,"*")]"" Q 1
I VISTAVAL'="" Q 1
Q 0
;
ASSIGNED(DEA) ; Is the DEA number assigned to a provider?
N PRNO,PRNAM
Q:'$$VALN1DEA^XUSER3(DEA) 0
S PRNO="" S PRNO=$O(^VA(200,"PS4",DEA,PRNO))
S PRNAM=$$GET1^DIQ(200,PRNO,.01)
Q PRNO_U_PRNAM
;
CHKP(PSOPAGE,PSOHEAD,PSORTYPE) ; Check for End Of Page
N PSOSCPAD S PSOSCPAD=$S($G(PSORTYPE)="D":15,1:6)
I $G(PSOPAGE) Q:'($Y>(IOSL-PSOSCPAD)) 0
S PSOQ=0
W !
I $E(IOST)="C" D Q:$G(PSOQ) PSOQ
. N X,Y,DTOUT,DUOUT,DIRUT,DIR
. U IO(0) S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT) PSOQ=1
. U IO
I $G(PSOPAGE) D HDR(.PSOPAGE,PSOHEAD,PSORTYPE)
Q PSOQ
;
HDR(PSOPAGE,PSOHEAD,PSORTYPE) ; Print Header
N X
W @IOF,PSOHEAD,?40,"Run Date: ",$$FMTE^XLFDT(DT,"5DZ"),$$RJ^XLFSTR("Page "_PSOPAGE,12)
S X="",$P(X,"=",79)="" W !,X
I $G(PSORTYPE)="D" D
. W !,"Asterisks ""**"" indicate the local value does not match the DOJ value."
S PSOPAGE=$G(PSOPAGE)+1
Q
;
EXIT ; Clean up
K ^TMP($J)
D CLOSE
Q
;
CLOSE D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
;
JSONFLDS ; JSON fields returned by web service
;address1
;address2
;address3
;businessActivityCode
;businessActivitySubcode
;city
;deaNumber
;drugSchedule
;expirationDate
;name
;processedDate
;state
;type
;zipCode
;***
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODEAMA 12719 printed Apr 09, 2024@21:34:17 Page 2
PSODEAMA ;DAL/JCH - Manually Entered DEA Report ;08/16/2021
+1 ;;7.0;OUTPATIENT PHARMACY;**545,731**;DEC 1997;Build 18
+2 ;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
+3 ;External reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
+4 ;
+5 QUIT
+6 ;
ENTRY ; Entry Point
+1 ;
+2 NEW PSODONE,PSOHEAD,PSORTYPE
+3 SET PSODONE=0
SET PSOHEAD="Manually Entered DEA Report"
+4 DO MESSAGE
+5 DO ASK(.PSORTYPE,.PSODONE)
if $GET(PSODONE)
QUIT
+6 ; Print to device
DO DEVICE(.PSODONE)
if PSODONE
QUIT
+7 DO PROCESS
+8 QUIT
+9 ;
PROCESS ; Process and Print Report Data
+1 DO RUN
+2 DO OUT
+3 DO CLOSE
+4 DO EXIT
+5 QUIT
+6 ;
MESSAGE ; Option informatoin
+1 ;
+2 WRITE !!,"This option lists DEA numbers that were added/edited via the Manual DEA Number"
+3 WRITE !,"Entry [PSO EPCS DEA MANUAL ENTRY] option and were not subsequently updated"
+4 WRITE !,"using the Add New Providers [PSO PROVIDER ADD] option or the Edit Provider"
+5 WRITE !,"[PSO PROVIDER EDIT] option while the PSO DOJ/DEA WEB SERVICE was running."
+6 WRITE !!,"Manually entered DEA numbers are removed from this list after they are edited"
+7 WRITE !,"using the Add New Providers [PSO PROVIDER ADD] option or the Edit Provider"
+8 WRITE !,"[PSO PROVIDER EDIT] option while the PSO DOJ/DEA WEB SERVICE is running."
+9 QUIT
+10 ;
ASK(PSORTYPE,PSODONE) ; Ask user's report options
+1 ; Summary or Detailed Report
+2 NEW DIR,X,Y
+3 SET DIR(0)="S^S:Summary;D:Detailed"
SET DIR("A")="Report Type"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET PSODONE=1
QUIT
+4 SET PSORTYPE=Y
SET PSOHEAD=PSOHEAD_$SELECT(Y="S":"(Summary)",1:"(Detailed)")
+5 QUIT
+6 ;
RUN ; Run Report
+1 NEW DEATXT,PSOLINE,WSDWN
+2 SET PSOLINE=1
SET WSDWN=0
+3 DO GATHER
+4 SET DEATXT=""
FOR
SET DEATXT=$ORDER(^TMP($JOB,"PSODEAMA","DEA",DEATXT))
if DEATXT=""
QUIT
Begin DoDot:1
+5 NEW IEN,IENS,WSAR,MANAR
+6 SET IEN=+$GET(^TMP($JOB,"PSODEAMA","DEA",DEATXT))
SET IENS=IEN_","
+7 DO GETMAN(IENS,.MANAR)
+8 IF DEATXT'=""
DO GETWS(DEATXT,.WSAR,.WSDWN)
+9 DO COMPILE(.MANAR,.WSAR,.PSOLINE,PSORTYPE)
End DoDot:1
+10 QUIT PSODONE
+11 ;
GATHER ; Identify Manually entered DEA #'s
+1 NEW DEAIEN,DEATXT,PSODONE
SET PSODONE=0
+2 KILL ^TMP($JOB,"PSODEAMA")
+3 SET DEAIEN=0
FOR
SET DEAIEN=$ORDER(^XTV(8991.9,DEAIEN))
if 'DEAIEN!$GET(PSODONE)
QUIT
Begin DoDot:1
+4 NEW RETURN,ERROR,FIELDS,DOJUPDT,IENS,MANAR,WSAR,DEATXT,WSDWN
+5 SET IENS=DEAIEN_","
+6 ; Quit if Last Updated by PSO DOJ/DEA WEB SERVICE
if $$GET1^DIQ(8991.9,IENS,10.3,"I")
QUIT
+7 SET DEATXT=$$GET1^DIQ(8991.9,IENS,.01,"E")
+8 SET ^TMP($JOB,"PSODEAMA","DEA",DEATXT)=DEAIEN
End DoDot:1
+9 QUIT
+10 ;
GETMAN(IENS,MANAR) ; Get one manually entered DEA number from DEA NUMBERS file (#8991.9)
+1 NEW TMPAR
+2 ;S FIELDS=".01;.02;.03;.04;.05;.06;.07;1.1;1.2;1.3;1.4;1.5;1.6;1.7;2.1;2.2;2.3;2.4;2.5;2.6;10.1;10.2;10.3" ;P731 detox/x-waiver removal
+3 SET FIELDS=".01;.02;.04;.05;.06;.07;1.1;1.2;1.3;1.4;1.5;1.6;1.7;2.1;2.2;2.3;2.4;2.5;2.6;10.1;10.2;10.3"
+4 DO GETS^DIQ(8991.9,IENS,FIELDS,,"MANAR","ERROR")
+5 MERGE TMPAR=MANAR(8991.9,IENS)
KILL MANAR
MERGE MANAR=TMPAR
+6 QUIT
+7 ;
GETWS(DEATXT,WSAR,WSDWN) ; Get one DEA#'s information from Web Service
+1 NEW RETURN,NOMORE,FLD,TXTLN
+2 SET NOMORE=0
+3 IF '$GET(WSDWN)
SET RETURN=$$WSGET^PSODEAUT(.WSAR,DEATXT)
+4 SET RETURN=$GET(RETURN)
+5 ; Web Service Down
IF $PIECE(RETURN,U,3)=6059
SET WSDWN=1
+6 IF (RETURN["DEA NUMBER NOT FOUND")!$GET(WSDWN)
Begin DoDot:1
+7 FOR TXTLN=1:1:999
if NOMORE
QUIT
SET FLD=$PIECE($TEXT(JSONFLDS+TXTLN),";",2)
Begin DoDot:2
+8 IF FLD="***"
SET NOMORE=1
QUIT
+9 IF FLD="deaNumber"
SET WSAR(FLD)=$SELECT($GET(WSDWN):"Unable to Connect",1:"Not Found")
QUIT
+10 SET WSAR(FLD)="**"
End DoDot:2
End DoDot:1
QUIT
+11 QUIT
+12 ;
COMPILE(MANAR,WSAR,PSOLINE,PSORTYPE) ; Print results
+1 NEW DS,DSII,DSIIN,DSIII,DSIIIN,DSIV,DSV,COL1IN,COL2IN,PSEXPDTE,PSDTRSLT,BAC,PSDTXDOJ,PSTYPE
+2 NEW PRNAM,PRNO,PRNOCONTXT,XIP
+3 SET COL1IN=20
SET COL2IN=21
+4 ;
+5 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=""
SET PSOLINE=PSOLINE+1
+6 SET PRNOCONTXT="Unable to Connect"
+7 ;
+8 SET PRNO=$$ASSIGNED(MANAR(.01))
+9 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)="DEA Number "_MANAR(.01)_$SELECT(PRNO:" assigned to "_$PIECE(PRNO,U,2)_" (IEN: "_+PRNO_")",1:" not assigned to any providers.")
+10 SET PSOLINE=PSOLINE+1
+11 ;
+12 if $GET(PSORTYPE)="S"
QUIT
+13 ;
+14 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("FIELD NAME",COL1IN)_$$LJ^XLFSTR("DOJ VALUE",COL2IN)_"LOCAL VISTA VALUE (Manual)"
+15 SET PSOLINE=PSOLINE+1
+16 SET $PIECE(^TMP($JOB,"PSODEAMA","OUT",PSOLINE),"-",75)="-"
+17 SET PSOLINE=PSOLINE+1
+18 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("DEA NUMBER: ",COL1IN)_$$LJ^XLFSTR(WSAR("deaNumber"),COL2IN)_MANAR(.01)
+19 SET PSOLINE=PSOLINE+1
+20 IF WSAR("name")'=MANAR(1.1)
Begin DoDot:1
+21 IF $GET(WSDWN)
SET WSAR("name")=PRNOCONTXT
QUIT
+22 if $EXTRACT(WSAR("name"),$LENGTH(WSAR("name")))'="*"
SET WSAR("name")=WSAR("name")_"**"
End DoDot:1
+23 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("NAME: ",COL1IN)_$$LJ^XLFSTR(WSAR("name"),COL2IN)_MANAR(1.1)
+24 SET PSOLINE=PSOLINE+1
+25 ;
+26 IF $$NULLCHK(WSAR("address1"),MANAR(1.2))
Begin DoDot:1
+27 IF WSAR("address1")'=MANAR(1.2)
Begin DoDot:2
+28 IF $GET(WSDWN)
SET WSAR("address1")=PRNOCONTXT
QUIT
+29 if WSAR("address1")'="**"
SET WSAR("address1")=WSAR("address1")_"**"
End DoDot:2
+30 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ADDRESS 1:",COL1IN)_$$LJ^XLFSTR(WSAR("address1"),COL2IN)_MANAR(1.2)
+31 SET PSOLINE=PSOLINE+1
End DoDot:1
+32 ;
+33 IF $$NULLCHK(WSAR("address2"),MANAR(1.3))
Begin DoDot:1
+34 IF WSAR("address2")'=MANAR(1.3)
Begin DoDot:2
+35 IF $GET(WSDWN)
SET WSAR("address2")=PRNOCONTXT
QUIT
+36 if WSAR("address2")'="**"
SET WSAR("address2")=WSAR("address2")_"**"
End DoDot:2
+37 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ADDRESS 2:",COL1IN)_$$LJ^XLFSTR(WSAR("address2"),COL2IN)_MANAR(1.3)
+38 SET PSOLINE=PSOLINE+1
End DoDot:1
+39 ;;
+40 ;I $$NULLCHK(WSAR("address3"),MANAR(1.4)) D
+41 ;.I WSAR("address3")'=MANAR(1.4) S:WSAR("address3")'="**" WSAR("address3")=WSAR("address3")_"**"
+42 ;.S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ADDRESS 3:",COL1IN)_$$LJ^XLFSTR(WSAR("address3"),COL2IN)_MANAR(1.4)
+43 ;.S PSOLINE=PSOLINE+1
+44 ;
+45 IF $$NULLCHK(WSAR("city"),MANAR(1.5))
Begin DoDot:1
+46 IF WSAR("city")'=MANAR(1.5)
Begin DoDot:2
+47 IF $GET(WSDWN)
SET WSAR("city")=PRNOCONTXT
QUIT
+48 if WSAR("city")'="**"
SET WSAR("city")=WSAR("city")_"**"
End DoDot:2
+49 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("CITY:",COL1IN)_$$LJ^XLFSTR(WSAR("city"),COL2IN)_MANAR(1.5)
+50 SET PSOLINE=PSOLINE+1
End DoDot:1
+51 ;
+52 IF $$NULLCHK(WSAR("state"),MANAR(1.6))
Begin DoDot:1
+53 DO POSTAL^XIPUTIL($GET(WSAR("zipCode")),.XIP)
SET XSTATE=$GET(XIP("STATE"))
+54 IF XSTATE'=MANAR(1.6)
Begin DoDot:2
+55 IF $GET(WSDWN)
SET XSTATE=PRNOCONTXT
QUIT
+56 if XSTATE'="**"
SET XSTATE=XSTATE_"**"
End DoDot:2
+57 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("STATE:",COL1IN)_$$LJ^XLFSTR(XSTATE,COL2IN)_MANAR(1.6)
+58 SET PSOLINE=PSOLINE+1
End DoDot:1
+59 ;
+60 IF $$NULLCHK(WSAR("zipCode"),MANAR(1.7))
Begin DoDot:1
+61 IF WSAR("zipCode")'=MANAR(1.7)
Begin DoDot:2
+62 IF $GET(WSDWN)
SET WSAR("zipCode")=PRNOCONTXT
QUIT
+63 if WSAR("zipCode")'="**"
SET WSAR("zipCode")=WSAR("zipCode")_"**"
End DoDot:2
+64 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ZIP:",COL1IN)_$$LJ^XLFSTR(WSAR("zipCode"),COL2IN)_MANAR(1.7)
+65 SET PSOLINE=PSOLINE+1
End DoDot:1
+66 ;
+67 SET BAC=$SELECT($GET(WSAR("businessActivityCode"))="**":"",1:$GET(WSAR("businessActivityCode")))_$SELECT($GET(WSAR("businessActivitySubcode"))="**":"",1:$GET(WSAR("businessActivitySubcode")))
+68 SET DEA=WSAR("deaNumber")
SET PSDTXDOJ=""
+69 IF BAC?1U
SET BAC=BAC_0
+70 IF BAC'=MANAR(.02)
Begin DoDot:1
+71 IF $GET(WSDWN)
SET BAC=PRNOCONTXT
QUIT
+72 if BAC'="**"
SET BAC=BAC_"**"
End DoDot:1
+73 IF $$NULLCHK(BAC,MANAR(.02))
Begin DoDot:1
+74 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("ACTIVITY CODE:",COL1IN)_$$LJ^XLFSTR(BAC,COL2IN)_MANAR(.02)
+75 SET PSOLINE=PSOLINE+1
End DoDot:1
+76 ;
+77 SET PSTYPE=BAC
IF $TRANSLATE(PSTYPE,"*")'=""
SET PSTYPE=$PIECE($$PROVTYPE^PSODEAUT(PSTYPE),"^",2)
+78 IF $$NULLCHK(WSAR("businessActivityCode"),MANAR(.07))
Begin DoDot:1
+79 IF $GET(WSDWN)
SET PSTYPE=PRNOCONTXT
+80 IF '$GET(WSDWN)
IF (PSTYPE'=MANAR(.07))
if $EXTRACT(PSTYPE,$LENGTH(PSTYPE))'="*"
SET PSTYPE=PSTYPE_"**"
+81 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("TYPE:",COL1IN)_$$LJ^XLFSTR(PSTYPE,COL2IN)_MANAR(.07)
+82 SET PSOLINE=PSOLINE+1
End DoDot:1
+83 ;
+84 ;P731 detox/x-waiver removal
+85 ;S BAC=$G(WSAR("businessActivityCode"))_WSAR("businessActivitySubcode")
+86 ;I $$NULLCHK(BAC,DEA) S PSDTXDOJ=$S($$DETOXCHK^PSODEAUT(BAC):"X"_$E(MANAR(.01),2,9),1:"")
+87 ;I $$NULLCHK(PSDTXDOJ,MANAR(.03)) D
+88 ;. I $G(WSDWN) S PSDTXDOJ=PRNOCONTXT
+89 ;. I '$G(WSDWN),(PSDTXDOJ'=MANAR(.03)) S:$E(PSDTXDOJ,$L(PSDTXDOJ))'="*" PSDTXDOJ=PSDTXDOJ_"**"
+90 ;. S ^TMP($J,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("DETOX NUMBER:",COL1IN)_$$LJ^XLFSTR(PSDTXDOJ,COL2IN)_MANAR(.03)
+91 ;. S PSOLINE=PSOLINE+1
+92 ;
+93 SET (PSDTRSLT,PSDTRSLT(0))=""
+94 IF $$NULLCHK(WSAR("expirationDate"),MANAR(.04))
DO DT^DILF("E",$GET(WSAR("expirationDate")),.PSDTRSLT)
+95 IF $GET(WSDWN)
SET PSDTRSLT(0)=PRNOCONTXT
+96 IF '$GET(WSDWN)
IF (PSDTRSLT(0)'=MANAR(.04))
if PSDTRSLT(0)'="**"
SET PSDTRSLT(0)=PSDTRSLT(0)_"**"
+97 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("EXPIRATION DATE:",COL1IN)_$$LJ^XLFSTR($GET(PSDTRSLT(0)),COL2IN)_MANAR(.04)
+98 SET PSOLINE=PSOLINE+1
+99 ;
+100 SET DS=WSAR("drugSchedule")
+101 ;
+102 IF $$NULLCHK(DS,MANAR(2.1))
Begin DoDot:1
+103 IF $GET(WSDWN)
SET DSII=PRNOCONTXT
+104 IF '$GET(WSDWN)
Begin DoDot:2
+105 SET DSII=$SELECT(DS["22N":"YES",(DS["2"&(DS'["2N")):"YES",DS="**":"",1:"NO")
+106 SET DSII=$GET(DSII)_$SELECT($GET(DSII)'=$GET(MANAR(2.1)):"**",1:"")
End DoDot:2
+107 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH II NARC:",COL1IN)_$$LJ^XLFSTR(DSII,COL2IN)_MANAR(2.1)
+108 SET PSOLINE=PSOLINE+1
End DoDot:1
+109 ;
+110 IF $$NULLCHK(DS,MANAR(2.2))
Begin DoDot:1
+111 IF $GET(WSDWN)
SET DSIIN=PRNOCONTXT
+112 IF '$GET(WSDWN)
Begin DoDot:2
+113 SET DSIIN=$SELECT(DS["2N":"YES",DS="**":"",1:"NO")
+114 SET DSIIN=DSIIN_$SELECT(DSIIN'=$GET(MANAR(2.2)):"**",1:"")
End DoDot:2
+115 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH II NON-NARC:",COL1IN)_$$LJ^XLFSTR(DSIIN,COL2IN)_MANAR(2.2)
+116 SET PSOLINE=PSOLINE+1
End DoDot:1
+117 ;
+118 IF $$NULLCHK(DS,MANAR(2.3))
Begin DoDot:1
+119 IF $GET(WSDWN)
SET DSIII=PRNOCONTXT
+120 IF '$GET(WSDWN)
Begin DoDot:2
+121 SET DSIII=$SELECT(DS="**":"",DS["33N":"YES",DS["3"&(DS'["3N"):"YES",1:"NO")
+122 SET DSIII=DSIII_$SELECT(DSIII'=$GET(MANAR(2.3)):"**",1:"")
End DoDot:2
+123 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH III NARC:",COL1IN)_$$LJ^XLFSTR(DSIII,COL2IN)_MANAR(2.3)
+124 SET PSOLINE=PSOLINE+1
End DoDot:1
+125 ;
+126 IF $$NULLCHK(DS,MANAR(2.4))
Begin DoDot:1
+127 IF $GET(WSDWN)
SET DSIIIN=PRNOCONTXT
+128 IF '$GET(WSDWN)
Begin DoDot:2
+129 SET DSIIIN=$SELECT(DS="**":"",DS["3N":"YES",1:"NO")
+130 SET DSIIIN=DSIIIN_$SELECT(DSIIIN'=$GET(MANAR(2.4)):"**",1:"")
End DoDot:2
+131 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH III NON-NARC:",COL1IN)_$$LJ^XLFSTR(DSIIIN,COL2IN)_MANAR(2.4)
+132 SET PSOLINE=PSOLINE+1
End DoDot:1
+133 ;
+134 IF $$NULLCHK(DS,MANAR(2.5))
Begin DoDot:1
+135 IF $GET(WSDWN)
SET DSIV=PRNOCONTXT
+136 IF '$GET(WSDWN)
Begin DoDot:2
+137 SET DSIV=$SELECT(DS="**":"",DS["4":"YES",1:"NO")
+138 SET DSIV=DSIV_$SELECT(DSIV'=$GET(MANAR(2.5)):"**",1:"")
End DoDot:2
+139 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH IV:",COL1IN)_$$LJ^XLFSTR(DSIV,COL2IN)_MANAR(2.5)
+140 SET PSOLINE=PSOLINE+1
End DoDot:1
+141 ;
+142 IF $$NULLCHK(DS,MANAR(2.6))
Begin DoDot:1
+143 IF $GET(WSDWN)
SET DSV=PRNOCONTXT
+144 IF '$GET(WSDWN)
Begin DoDot:2
+145 ; SCHEDULE V
SET DSV=$SELECT(DS="**":"",DS["5":"YES",1:"NO")
+146 SET DSV=DSV_$SELECT(DSV'=$GET(MANAR(2.6)):"**",1:"")
End DoDot:2
+147 SET ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=$$LJ^XLFSTR("SCH V:",COL1IN)_$$LJ^XLFSTR(DSV,COL2IN)_MANAR(2.6)
+148 SET PSOLINE=PSOLINE+1
End DoDot:1
+149 ;
+150 QUIT
+151 ;
OUT ; Write Output
+1 NEW PSOLINE,PSOPAGE,DIR,Y,PSODONE,PSOQ
+2 SET PSOLINE=0
SET PSOPAGE=1
+3 IF $DATA(IO("Q"))
DO CLEAR^VALM1
+4 USE IO
+5 FOR
SET PSOLINE=$ORDER(^TMP($JOB,"PSODEAMA","OUT",PSOLINE))
if 'PSOLINE!$GET(PSODONE)
QUIT
Begin DoDot:1
+6 IF PSOLINE>1
Begin DoDot:2
+7 IF ($GET(PSORTYPE)'="S")
IF ^TMP($JOB,"PSODEAMA","OUT",PSOLINE)=""
Begin DoDot:3
+8 SET PSODONE=$$CHKP(.PSOPAGE,PSOHEAD,PSORTYPE)
if $GET(PSODONE)
QUIT
End DoDot:3
if $GET(PSODONE)
QUIT
+9 IF $GET(PSORTYPE)="S"
SET PSODONE=$$CHKP(.PSOPAGE,PSOHEAD,PSORTYPE)
if $GET(PSODONE)
QUIT
End DoDot:2
+10 IF PSOLINE=1
DO HDR(.PSOPAGE,PSOHEAD,PSORTYPE)
+11 WRITE !,^TMP($JOB,"PSODEAMA","OUT",PSOLINE)
End DoDot:1
+12 IF '$GET(PSODONE)
SET PSODONE=$$CHKP(0)
+13 QUIT
+14 ;
DEVICE(PSODONE) ; Request Device Information
+1 NEW %ZIS,IOP,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP,RTN,VAR
+2 KILL IO("Q")
+3 SET %ZIS="QM"
+4 WRITE !
DO ^%ZIS
IF POP
SET PSODONE=1
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET RTN=$PIECE($TEXT(+1)," ",1)
+7 SET ZTRTN="PROCESS^PSODEAMA"
+8 SET ZTIO=ION
+9 SET ZTSAVE("PS*")=""
+10 SET ZTDESC="MANUAL DEA ENTRY REPORT"
+11 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Report is Queued to print (Task "_ZTSK_")",1:"REQUEST CANCELLED")
KILL ZTSK
+12 SET PSODONE=1
End DoDot:1
+13 QUIT
+14 ;
NULLCHK(DOJVAL,VISTAVAL) ; Check for null value, filter out askterisks
+1 IF $TRANSLATE(DOJVAL,"*")]""
QUIT 1
+2 IF VISTAVAL'=""
QUIT 1
+3 QUIT 0
+4 ;
ASSIGNED(DEA) ; Is the DEA number assigned to a provider?
+1 NEW PRNO,PRNAM
+2 if '$$VALN1DEA^XUSER3(DEA)
QUIT 0
+3 SET PRNO=""
SET PRNO=$ORDER(^VA(200,"PS4",DEA,PRNO))
+4 SET PRNAM=$$GET1^DIQ(200,PRNO,.01)
+5 QUIT PRNO_U_PRNAM
+6 ;
CHKP(PSOPAGE,PSOHEAD,PSORTYPE) ; Check for End Of Page
+1 NEW PSOSCPAD
SET PSOSCPAD=$SELECT($GET(PSORTYPE)="D":15,1:6)
+2 IF $GET(PSOPAGE)
if '($Y>(IOSL-PSOSCPAD))
QUIT 0
+3 SET PSOQ=0
+4 WRITE !
+5 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+6 NEW X,Y,DTOUT,DUOUT,DIRUT,DIR
+7 USE IO(0)
SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET PSOQ=1
+8 USE IO
End DoDot:1
if $GET(PSOQ)
QUIT PSOQ
+9 IF $GET(PSOPAGE)
DO HDR(.PSOPAGE,PSOHEAD,PSORTYPE)
+10 QUIT PSOQ
+11 ;
HDR(PSOPAGE,PSOHEAD,PSORTYPE) ; Print Header
+1 NEW X
+2 WRITE @IOF,PSOHEAD,?40,"Run Date: ",$$FMTE^XLFDT(DT,"5DZ"),$$RJ^XLFSTR("Page "_PSOPAGE,12)
+3 SET X=""
SET $PIECE(X,"=",79)=""
WRITE !,X
+4 IF $GET(PSORTYPE)="D"
Begin DoDot:1
+5 WRITE !,"Asterisks ""**"" indicate the local value does not match the DOJ value."
End DoDot:1
+6 SET PSOPAGE=$GET(PSOPAGE)+1
+7 QUIT
+8 ;
EXIT ; Clean up
+1 KILL ^TMP($JOB)
+2 DO CLOSE
+3 QUIT
+4 ;
CLOSE DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 QUIT
+2 ;
JSONFLDS ; JSON fields returned by web service
+1 ;address1
+2 ;address2
+3 ;address3
+4 ;businessActivityCode
+5 ;businessActivitySubcode
+6 ;city
+7 ;deaNumber
+8 ;drugSchedule
+9 ;expirationDate
+10 ;name
+11 ;processedDate
+12 ;state
+13 ;type
+14 ;zipCode
+15 ;***
