- 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 Mar 13, 2025@21:34:53 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
