ORDEA02 ;ISL/JLC - DEA PROVIDER REPORT ; 9/13/17 2:24pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**371,465**;Dec 17, 1997;Build 7
;
;DBIA reference section
;10017 ^DD("DD"
;10003 DD^%DT
;10063 $$S^%ZTLOAD
;10015 EN^DIQ1
;10103 $$NOW^XLFDT
;10070 ^XMD
; 4820 RX^PSO52API
;
Q
EN ;TaskMan entry point
N YR,MN,ORREPH,ORREP,ORPROV,BL,S1,S3,ORRX,DATA0,DATA1,DATA3,DATA5,ORPNM,ORDRUG,ORDEA,ORCNT,ORISS,Y,ORDT,DIC,DA,DR,DIQ,ORS,ORIFN
S ZTSTOP=0 K ^TMP($J,"CS BY PROV")
S DT=$$NOW^XLFDT,YR=$E(DT,1,3)+1700,MN=$E(100+$E(DT,4,5)-1,2,99) I MN<1 S MN=12,YR=YR-1
S Y=YR-1700_MN D DD^%DT S ORREPH=Y,ORREP=YR-1700_$E(MN+100,2,3),ORPROV=0,$P(BL," ",99)=""
F S ORPROV=$O(^ORPA(101.52,"C",ORPROV)) Q:'ORPROV D I ZTSTOP Q
. S S1=ORREP K ^TMP($J,"CS BY PROV") S ORCNT=0
. F S S1=$O(^ORPA(101.52,"C",ORPROV,S1)) Q:'S1 I $E(S1,1,5)=ORREP D
.. S S3=0
.. F S S3=$O(^ORPA(101.52,"C",ORPROV,S1,S3)) Q:'S3 D
... S DATA0=$G(^ORPA(101.52,S3,0)),DATA1=$G(^(1)),DATA3=$G(^(3)),DATA5=$G(^(5))
... S ORIFN=$P(DATA0,"^"),ORRX=$P(DATA0,"^",2)
... I ORRX="" S DA=$P(^OR(100,ORIFN,3),"^",3) S DIC=100.01,DR=.01,DIQ="ORS" D EN^DIQ1 S ORRX=ORS(100.01,DA,.01)
... I ORRX S ORRX=$$RXNUM($P(DATA5,"^",2),ORRX)
... S ORRX=ORRX_BL,ORPNM=$P(DATA5,"^")_BL,ORDRUG=$E($P(DATA1,"^",2),1,22)_BL,ORDEA=$E($P(DATA1,"^",4))_BL
... I 'ORCNT D
.... S ORCNT=ORCNT+1,^TMP($J,"CS BY PROV",ORCNT,0)=$E(BL,1,16)_"Monthly Controlled Substances Issued by Provider"
.... S ORCNT=ORCNT+1,^TMP($J,"CS BY PROV",ORCNT,0)="Report for: "_ORREPH_" for "_$P(DATA3,"^",3)
.... S ORCNT=ORCNT+1,^TMP($J,"CS BY PROV",ORCNT,0)=" "
.... S ORCNT=ORCNT+1,^TMP($J,"CS BY PROV",ORCNT,0)=$E("PATIENT NAME"_BL,1,25)_$E("DRUG NAME"_BL,1,25)_"SCH "_$E("ISSUE DATE"_BL,1,13)_$E("RX #"_BL,1,12)
.... S ORCNT=ORCNT+1,^TMP($J,"CS BY PROV",ORCNT,0)=" "
... S Y=$P(DATA1,"^") X ^DD("DD") S ORISS=Y_BL
... S ORCNT=ORCNT+1,^TMP($J,"CS BY PROV",ORCNT,0)=$E(ORPNM,1,23)_" "_$E(ORDRUG,1,24)_" "_$E(ORDEA)_" "_$E(ORISS,1,13)_$E(ORRX,1,11)
. D SEND K ^TMP($J)
. S ZTSTOP=$$REQ2STOP()
S ZTREQ="@" Q
SEND ;
Q:'$D(^TMP($J,"CS BY PROV")) N XMY,XMDUZ,XMSUB,XMTEXT
S XMDUZ="CPRS,REPORT",XMY(ORPROV)="",XMSUB="MONTHLY CONTROLLED SUBSTANCES REPORT",XMTEXT="^TMP("_$J_",""CS BY PROV"","
D ^XMD Q
REQ2STOP() ;
; Check for task stop request
; Returns 1 if stop request made.
N STATUS,X
S STATUS=0
I '$D(ZTQUEUED) Q 0
S X=$$S^%ZTLOAD()
I X D ;
. S STATUS=1
. S X=$$S^%ZTLOAD("Received shutdown request")
;
Q STATUS
RXNUM(DFN,RXIEN) N RXNUM K ^TMP($J,"RX")
S RXIEN=+$G(RXIEN)
D RX^PSO52API(DFN,"RX",RXIEN,,0)
S RXNUM=$G(^TMP($J,"RX",DFN,RXIEN,.01))
K ^TMP($J,"RX")
Q RXNUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDEA02 2687 printed Oct 16, 2024@18:30:32 Page 2
ORDEA02 ;ISL/JLC - DEA PROVIDER REPORT ; 9/13/17 2:24pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**371,465**;Dec 17, 1997;Build 7
+2 ;
+3 ;DBIA reference section
+4 ;10017 ^DD("DD"
+5 ;10003 DD^%DT
+6 ;10063 $$S^%ZTLOAD
+7 ;10015 EN^DIQ1
+8 ;10103 $$NOW^XLFDT
+9 ;10070 ^XMD
+10 ; 4820 RX^PSO52API
+11 ;
+12 QUIT
EN ;TaskMan entry point
+1 NEW YR,MN,ORREPH,ORREP,ORPROV,BL,S1,S3,ORRX,DATA0,DATA1,DATA3,DATA5,ORPNM,ORDRUG,ORDEA,ORCNT,ORISS,Y,ORDT,DIC,DA,DR,DIQ,ORS,ORIFN
+2 SET ZTSTOP=0
KILL ^TMP($JOB,"CS BY PROV")
+3 SET DT=$$NOW^XLFDT
SET YR=$EXTRACT(DT,1,3)+1700
SET MN=$EXTRACT(100+$EXTRACT(DT,4,5)-1,2,99)
IF MN<1
SET MN=12
SET YR=YR-1
+4 SET Y=YR-1700_MN
DO DD^%DT
SET ORREPH=Y
SET ORREP=YR-1700_$EXTRACT(MN+100,2,3)
SET ORPROV=0
SET $PIECE(BL," ",99)=""
+5 FOR
SET ORPROV=$ORDER(^ORPA(101.52,"C",ORPROV))
if 'ORPROV
QUIT
Begin DoDot:1
+6 SET S1=ORREP
KILL ^TMP($JOB,"CS BY PROV")
SET ORCNT=0
+7 FOR
SET S1=$ORDER(^ORPA(101.52,"C",ORPROV,S1))
if 'S1
QUIT
IF $EXTRACT(S1,1,5)=ORREP
Begin DoDot:2
+8 SET S3=0
+9 FOR
SET S3=$ORDER(^ORPA(101.52,"C",ORPROV,S1,S3))
if 'S3
QUIT
Begin DoDot:3
+10 SET DATA0=$GET(^ORPA(101.52,S3,0))
SET DATA1=$GET(^(1))
SET DATA3=$GET(^(3))
SET DATA5=$GET(^(5))
+11 SET ORIFN=$PIECE(DATA0,"^")
SET ORRX=$PIECE(DATA0,"^",2)
+12 IF ORRX=""
SET DA=$PIECE(^OR(100,ORIFN,3),"^",3)
SET DIC=100.01
SET DR=.01
SET DIQ="ORS"
DO EN^DIQ1
SET ORRX=ORS(100.01,DA,.01)
+13 IF ORRX
SET ORRX=$$RXNUM($PIECE(DATA5,"^",2),ORRX)
+14 SET ORRX=ORRX_BL
SET ORPNM=$PIECE(DATA5,"^")_BL
SET ORDRUG=$EXTRACT($PIECE(DATA1,"^",2),1,22)_BL
SET ORDEA=$EXTRACT($PIECE(DATA1,"^",4))_BL
+15 IF 'ORCNT
Begin DoDot:4
+16 SET ORCNT=ORCNT+1
SET ^TMP($JOB,"CS BY PROV",ORCNT,0)=$EXTRACT(BL,1,16)_"Monthly Controlled Substances Issued by Provider"
+17 SET ORCNT=ORCNT+1
SET ^TMP($JOB,"CS BY PROV",ORCNT,0)="Report for: "_ORREPH_" for "_$PIECE(DATA3,"^",3)
+18 SET ORCNT=ORCNT+1
SET ^TMP($JOB,"CS BY PROV",ORCNT,0)=" "
+19 SET ORCNT=ORCNT+1
SET ^TMP($JOB,"CS BY PROV",ORCNT,0)=$EXTRACT("PATIENT NAME"_BL,1,25)_$EXTRACT("DRUG NAME"_BL,1,25)_"SCH "_$EXTRACT("ISSUE DATE"_BL,1,13)_$EXTRACT("RX #"_BL,1,12)
+20 SET ORCNT=ORCNT+1
SET ^TMP($JOB,"CS BY PROV",ORCNT,0)=" "
End DoDot:4
+21 SET Y=$PIECE(DATA1,"^")
XECUTE ^DD("DD")
SET ORISS=Y_BL
+22 SET ORCNT=ORCNT+1
SET ^TMP($JOB,"CS BY PROV",ORCNT,0)=$EXTRACT(ORPNM,1,23)_" "_$EXTRACT(ORDRUG,1,24)_" "_$EXTRACT(ORDEA)_" "_$EXTRACT(ORISS,1,13)_$EXTRACT(ORRX,1,11)
End DoDot:3
End DoDot:2
+23 DO SEND
KILL ^TMP($JOB)
+24 SET ZTSTOP=$$REQ2STOP()
End DoDot:1
IF ZTSTOP
QUIT
+25 SET ZTREQ="@"
QUIT
SEND ;
+1 if '$DATA(^TMP($JOB,"CS BY PROV"))
QUIT
NEW XMY,XMDUZ,XMSUB,XMTEXT
+2 SET XMDUZ="CPRS,REPORT"
SET XMY(ORPROV)=""
SET XMSUB="MONTHLY CONTROLLED SUBSTANCES REPORT"
SET XMTEXT="^TMP("_$JOB_",""CS BY PROV"","
+3 DO ^XMD
QUIT
REQ2STOP() ;
+1 ; Check for task stop request
+2 ; Returns 1 if stop request made.
+3 NEW STATUS,X
+4 SET STATUS=0
+5 IF '$DATA(ZTQUEUED)
QUIT 0
+6 SET X=$$S^%ZTLOAD()
+7 ;
IF X
Begin DoDot:1
+8 SET STATUS=1
+9 SET X=$$S^%ZTLOAD("Received shutdown request")
End DoDot:1
+10 ;
+11 QUIT STATUS
RXNUM(DFN,RXIEN) NEW RXNUM
KILL ^TMP($JOB,"RX")
+1 SET RXIEN=+$GET(RXIEN)
+2 DO RX^PSO52API(DFN,"RX",RXIEN,,0)
+3 SET RXNUM=$GET(^TMP($JOB,"RX",DFN,RXIEN,.01))
+4 KILL ^TMP($JOB,"RX")
+5 QUIT RXNUM
