- PSO525AP ;BHAM ISC/SAB- encap II API to return suspended Rx data ; 04/07/05 10:30 am
- ;;7.0;OUTPATIENT PHARMACY;**213,229**;DEC 1997
- ;
- SUS(LIST,DFN,IEN,RX,SDATE,EDATE) ;
- ;
- ;LIST: Subscript name used in ^TMP global [REQUIRED]
- ;DFN: Patient's IEN
- ;IEN: Internal record number [optional]
- ;RX #: Pointer to Prescription file (#52) [optional]
- ;SDATE: Starting Suspense Date [optional]
- ;EDATE: Ending Suspense Date [optional]
- ;
- Q:$G(LIST)=""
- N DA,DR,PSOPOST,DIC,DIQ,ND,LK K ^TMP($J,LIST)
- I $G(IEN) D G CLEAN
- .I $G(^PS(52.5,IEN,0))']"" S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND" Q
- .D PROCESS
- I $G(RX)]"",'$G(IEN) S IEN=$O(^PS(52.5,"B",RX,0)) D G CLEAN
- .I 'IEN Q
- .D PROCESS
- I $G(SDATE)!($G(EDATE)) D DATE G CLEAN
- I $G(DFN) F IEN=0:0 S IEN=$O(^PS(52.5,"AF",DFN,IEN)) Q:'IEN D
- .I DFN'=$P($G(^PS(52.5,IEN,0)),"^",3) S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)" Q
- .D PROCESS
- I '$G(DFN) F DFN=0:0 S DFN=$O(^PS(52.5,"AF",DFN)) Q:'DFN F IEN=0:0 S IEN=$O(^PS(52.5,"AF",DFN,IEN)) Q:'IEN D PROCESS
- CLEAN I $G(DFN),'$O(^TMP($J,LIST,DFN,0)) S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND"
- I '$G(DFN),'$O(^TMP($J,LIST,0)) S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
- K DA,DR,DIC,PSOPOST,DIQ,LDATE
- Q
- PROCESS ;
- I $G(^PS(52.5,IEN,0))']"" S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND" Q
- I $G(DFN),DFN'=$P($G(^PS(52.5,IEN,0)),"^",3) Q
- K PSOPOST S DIC=52.5,DA=IEN,DR=".01;.02;.03;.05;2;3;9",DIQ="PSOPOST",DIQ(0)="IE" D EN^DIQ1
- F DR=.01,.02,.03,.05,2,3,9 D
- .I DR=.01 S ^TMP($J,LIST,"B",PSOPOST(52.5,DA,DR,"I"),IEN)=""
- .I DR=.03 S ^TMP($J,LIST,PSOPOST(52.5,DA,.03,"I"),0)=$G(^TMP($J,LIST,PSOPOST(52.5,DA,.03,"I"),0))+1
- .I PSOPOST(52.5,DA,DR,"E")'=PSOPOST(52.5,DA,DR,"I") S ^TMP($J,LIST,PSOPOST(52.5,DA,.03,"I"),IEN,DR)=PSOPOST(52.5,DA,DR,"I")_"^"_PSOPOST(52.5,DA,DR,"E") Q
- .S ^TMP($J,LIST,PSOPOST(52.5,DA,.03,"I"),IEN,DR)=PSOPOST(52.5,DA,DR,"I")
- K DA,DR,PSOPOST,DIC,DIQ
- Q
- DATE ;date range
- I $G(SDATE) S LDATE=SDATE-1 D Q
- .I $G(EDATE) F S LDATE=$O(^PS(52.5,"C",LDATE)) Q:'LDATE!(LDATE>EDATE) F IEN=0:0 S IEN=$O(^PS(52.5,"C",LDATE,IEN)) Q:'IEN D PROCESS
- .I '$G(EDATE) F S LDATE=$O(^PS(52.5,"C",LDATE)) Q:'LDATE F IEN=0:0 S IEN=$O(^PS(52.5,"C",LDATE,IEN)) Q:'IEN D PROCESS
- I $G(EDATE) S LDATE=0 F S LDATE=$O(^PS(52.5,"C",LDATE)) Q:'LDATE!(LDATE>EDATE) F IEN=0:0 S IEN=$O(^PS(52.5,"C",LDATE,IEN)) Q:'IEN D PROCESS
- Q
- PSO525AP ;BHAM ISC/SAB- encap II API to return suspended Rx data ; 04/07/05 10:30 am
- +1 ;;7.0;OUTPATIENT PHARMACY;**213,229**;DEC 1997
- +2 ;
- SUS(LIST,DFN,IEN,RX,SDATE,EDATE) ;
- +1 ;
- +2 ;LIST: Subscript name used in ^TMP global [REQUIRED]
- +3 ;DFN: Patient's IEN
- +4 ;IEN: Internal record number [optional]
- +5 ;RX #: Pointer to Prescription file (#52) [optional]
- +6 ;SDATE: Starting Suspense Date [optional]
- +7 ;EDATE: Ending Suspense Date [optional]
- +8 ;
- +9 IF $GET(LIST)=""
- QUIT
- +10 NEW DA,DR,PSOPOST,DIC,DIQ,ND,LK
- KILL ^TMP($JOB,LIST)
- +11 IF $GET(IEN)
- Begin DoDot:1
- +12 IF $GET(^PS(52.5,IEN,0))']""
- SET ^TMP($JOB,LIST,IEN,0)="-1^NO DATA FOUND"
- QUIT
- +13 DO PROCESS
- End DoDot:1
- GOTO CLEAN
- +14 IF $GET(RX)]""
- IF '$GET(IEN)
- SET IEN=$ORDER(^PS(52.5,"B",RX,0))
- Begin DoDot:1
- +15 IF 'IEN
- QUIT
- +16 DO PROCESS
- End DoDot:1
- GOTO CLEAN
- +17 IF $GET(SDATE)!($GET(EDATE))
- DO DATE
- GOTO CLEAN
- +18 IF $GET(DFN)
- FOR IEN=0:0
- SET IEN=$ORDER(^PS(52.5,"AF",DFN,IEN))
- IF 'IEN
- QUIT
- Begin DoDot:1
- +19 IF DFN'=$PIECE($GET(^PS(52.5,IEN,0)),"^",3)
- SET ^TMP($JOB,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)"
- QUIT
- +20 DO PROCESS
- End DoDot:1
- +21 IF '$GET(DFN)
- FOR DFN=0:0
- SET DFN=$ORDER(^PS(52.5,"AF",DFN))
- IF 'DFN
- QUIT
- FOR IEN=0:0
- SET IEN=$ORDER(^PS(52.5,"AF",DFN,IEN))
- IF 'IEN
- QUIT
- DO PROCESS
- CLEAN IF $GET(DFN)
- IF '$ORDER(^TMP($JOB,LIST,DFN,0))
- SET ^TMP($JOB,LIST,DFN,0)="-1^NO DATA FOUND"
- +1 IF '$GET(DFN)
- IF '$ORDER(^TMP($JOB,LIST,0))
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- +2 KILL DA,DR,DIC,PSOPOST,DIQ,LDATE
- +3 QUIT
- PROCESS ;
- +1 IF $GET(^PS(52.5,IEN,0))']""
- SET ^TMP($JOB,LIST,IEN,0)="-1^NO DATA FOUND"
- QUIT
- +2 IF $GET(DFN)
- IF DFN'=$PIECE($GET(^PS(52.5,IEN,0)),"^",3)
- QUIT
- +3 KILL PSOPOST
- SET DIC=52.5
- SET DA=IEN
- SET DR=".01;.02;.03;.05;2;3;9"
- SET DIQ="PSOPOST"
- SET DIQ(0)="IE"
- DO EN^DIQ1
- +4 FOR DR=.01,.02,.03,.05,2,3,9
- Begin DoDot:1
- +5 IF DR=.01
- SET ^TMP($JOB,LIST,"B",PSOPOST(52.5,DA,DR,"I"),IEN)=""
- +6 IF DR=.03
- SET ^TMP($JOB,LIST,PSOPOST(52.5,DA,.03,"I"),0)=$GET(^TMP($JOB,LIST,PSOPOST(52.5,DA,.03,"I"),0))+1
- +7 IF PSOPOST(52.5,DA,DR,"E")'=PSOPOST(52.5,DA,DR,"I")
- SET ^TMP($JOB,LIST,PSOPOST(52.5,DA,.03,"I"),IEN,DR)=PSOPOST(52.5,DA,DR,"I")_"^"_PSOPOST(52.5,DA,DR,"E")
- QUIT
- +8 SET ^TMP($JOB,LIST,PSOPOST(52.5,DA,.03,"I"),IEN,DR)=PSOPOST(52.5,DA,DR,"I")
- End DoDot:1
- +9 KILL DA,DR,PSOPOST,DIC,DIQ
- +10 QUIT
- DATE ;date range
- +1 IF $GET(SDATE)
- SET LDATE=SDATE-1
- Begin DoDot:1
- +2 IF $GET(EDATE)
- FOR
- SET LDATE=$ORDER(^PS(52.5,"C",LDATE))
- IF 'LDATE!(LDATE>EDATE)
- QUIT
- FOR IEN=0:0
- SET IEN=$ORDER(^PS(52.5,"C",LDATE,IEN))
- IF 'IEN
- QUIT
- DO PROCESS
- +3 IF '$GET(EDATE)
- FOR
- SET LDATE=$ORDER(^PS(52.5,"C",LDATE))
- IF 'LDATE
- QUIT
- FOR IEN=0:0
- SET IEN=$ORDER(^PS(52.5,"C",LDATE,IEN))
- IF 'IEN
- QUIT
- DO PROCESS
- End DoDot:1
- QUIT
- +4 IF $GET(EDATE)
- SET LDATE=0
- FOR
- SET LDATE=$ORDER(^PS(52.5,"C",LDATE))
- IF 'LDATE!(LDATE>EDATE)
- QUIT
- FOR IEN=0:0
- SET IEN=$ORDER(^PS(52.5,"C",LDATE,IEN))
- IF 'IEN
- QUIT
- DO PROCESS
- +5 QUIT
