- PSO5241 ;BHAM ISC/SAB- encap II API to return pending Rx data ; 04/07/05 10:30 am
- ;;7.0;OUTPATIENT PHARMACY;**213**;DEC 1997
- ;^PSDRUG supported by DBIA 221
- ;^PS(50.7 supported by DBIA 2223
- ;
- PEN(DFN,LIST,IEN,PLACER) ;
- ;
- ;DFN: Patient's IEN
- ;LIST: Subscript name used in ^TMP global [REQUIRED]
- ;IEN: Internal record number [optional]
- ;PLACER: Pointer to Orders file (#100) [optional]
- ;
- Q:$G(DFN)']"" Q:$G(LIST)=""
- N DA,DR,PSOPOST,DIC,DIQ,ND,LK K ^TMP($J,LIST)
- S ^TMP($J,LIST,DFN,0)=0
- I $G(IEN) D PROCESS G CLEAN
- I $G(PLACER)]"",'$G(IEN) S IEN=$O(^PS(52.41,"B",PLACER,0)) D G CLEAN
- .I 'IEN S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND" Q
- .D PROCESS
- F IEN=0:0 S IEN=$O(^PS(52.41,"P",DFN,IEN)) Q:'IEN D PROCESS
- CLEAN I ^TMP($J,LIST,DFN,0)=0 S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND"
- K DA,DR,DIC,PSOPOST,DIQ
- Q
- PROCESS ;
- Q:$P($G(^PS(52.41,IEN,0)),"^",3)="DC" Q:$P($G(^PS(52.41,IEN,0)),"^",3)="DE"
- I DFN'=$P($G(^PS(52.41,IEN,0)),"^",2) S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)" Q
- I $G(^PS(52.41,IEN,0))']"" S ^TMP($J,LIST,DFN,IEN,0)="-1^NO DATA FOUND" Q
- K PSOPOST S DIC=52.41,DA=IEN,DR=".01;2;8;9;11",DIQ="PSOPOST",DIQ(0)="IE" D EN^DIQ1
- F DR=.01,2,8 D I DR=8 D OI
- .I DR=.01 S ^TMP($J,LIST,DFN,"B",PSOPOST(52.41,DA,DR,"I"),IEN)=""
- .I PSOPOST(52.41,DA,DR,"E")'=PSOPOST(52.41,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PSOPOST(52.41,DA,DR,"I")_"^"_PSOPOST(52.41,DA,DR,"E") Q
- .S ^TMP($J,LIST,DFN,IEN,DR)=PSOPOST(52.41,DA,DR,"I")
- S DR=11 D
- .I PSOPOST(52.41,IEN,DR,"E")'=PSOPOST(52.41,IEN,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PSOPOST(52.41,IEN,DR,"I")_"^"_PSOPOST(52.41,IEN,DR,"E") Q
- .S ^TMP($J,LIST,DFN,IEN,DR)=PSOPOST(52.41,IEN,DR,"I")
- S ^TMP($J,LIST,DFN,0)=^TMP($J,LIST,DFN,0)+1
- K DA,DR,PSOPOST,DIC,DIQ
- Q
- OI ;orderable item
- S DIC=50.7,DA=PSOPOST(52.41,DA,DR,"I"),DR=.02,DIQ(0)="IE" D EN^DIQ1
- S ^TMP($J,LIST,DFN,IEN,8)=^TMP($J,LIST,DFN,IEN,8)_"^"_PSOPOST(50.7,DA,DR,"I")_"^"_PSOPOST(50.7,DA,DR,"E")
- Q
- PSO5241 ;BHAM ISC/SAB- encap II API to return pending Rx data ; 04/07/05 10:30 am
- +1 ;;7.0;OUTPATIENT PHARMACY;**213**;DEC 1997
- +2 ;^PSDRUG supported by DBIA 221
- +3 ;^PS(50.7 supported by DBIA 2223
- +4 ;
- PEN(DFN,LIST,IEN,PLACER) ;
- +1 ;
- +2 ;DFN: Patient's IEN
- +3 ;LIST: Subscript name used in ^TMP global [REQUIRED]
- +4 ;IEN: Internal record number [optional]
- +5 ;PLACER: Pointer to Orders file (#100) [optional]
- +6 ;
- +7 IF $GET(DFN)']""
- QUIT
- IF $GET(LIST)=""
- QUIT
- +8 NEW DA,DR,PSOPOST,DIC,DIQ,ND,LK
- KILL ^TMP($JOB,LIST)
- +9 SET ^TMP($JOB,LIST,DFN,0)=0
- +10 IF $GET(IEN)
- DO PROCESS
- GOTO CLEAN
- +11 IF $GET(PLACER)]""
- IF '$GET(IEN)
- SET IEN=$ORDER(^PS(52.41,"B",PLACER,0))
- Begin DoDot:1
- +12 IF 'IEN
- SET ^TMP($JOB,LIST,DFN,0)="-1^NO DATA FOUND"
- QUIT
- +13 DO PROCESS
- End DoDot:1
- GOTO CLEAN
- +14 FOR IEN=0:0
- SET IEN=$ORDER(^PS(52.41,"P",DFN,IEN))
- IF 'IEN
- QUIT
- DO PROCESS
- CLEAN IF ^TMP($JOB,LIST,DFN,0)=0
- SET ^TMP($JOB,LIST,DFN,0)="-1^NO DATA FOUND"
- +1 KILL DA,DR,DIC,PSOPOST,DIQ
- +2 QUIT
- PROCESS ;
- +1 IF $PIECE($GET(^PS(52.41,IEN,0)),"^",3)="DC"
- QUIT
- IF $PIECE($GET(^PS(52.41,IEN,0)),"^",3)="DE"
- QUIT
- +2 IF DFN'=$PIECE($GET(^PS(52.41,IEN,0)),"^",2)
- SET ^TMP($JOB,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)"
- QUIT
- +3 IF $GET(^PS(52.41,IEN,0))']""
- SET ^TMP($JOB,LIST,DFN,IEN,0)="-1^NO DATA FOUND"
- QUIT
- +4 KILL PSOPOST
- SET DIC=52.41
- SET DA=IEN
- SET DR=".01;2;8;9;11"
- SET DIQ="PSOPOST"
- SET DIQ(0)="IE"
- DO EN^DIQ1
- +5 FOR DR=.01,2,8
- Begin DoDot:1
- +6 IF DR=.01
- SET ^TMP($JOB,LIST,DFN,"B",PSOPOST(52.41,DA,DR,"I"),IEN)=""
- +7 IF PSOPOST(52.41,DA,DR,"E")'=PSOPOST(52.41,DA,DR,"I")
- SET ^TMP($JOB,LIST,DFN,IEN,DR)=PSOPOST(52.41,DA,DR,"I")_"^"_PSOPOST(52.41,DA,DR,"E")
- QUIT
- +8 SET ^TMP($JOB,LIST,DFN,IEN,DR)=PSOPOST(52.41,DA,DR,"I")
- End DoDot:1
- IF DR=8
- DO OI
- +9 SET DR=11
- Begin DoDot:1
- +10 IF PSOPOST(52.41,IEN,DR,"E")'=PSOPOST(52.41,IEN,DR,"I")
- SET ^TMP($JOB,LIST,DFN,IEN,DR)=PSOPOST(52.41,IEN,DR,"I")_"^"_PSOPOST(52.41,IEN,DR,"E")
- QUIT
- +11 SET ^TMP($JOB,LIST,DFN,IEN,DR)=PSOPOST(52.41,IEN,DR,"I")
- End DoDot:1
- +12 SET ^TMP($JOB,LIST,DFN,0)=^TMP($JOB,LIST,DFN,0)+1
- +13 KILL DA,DR,PSOPOST,DIC,DIQ
- +14 QUIT
- OI ;orderable item
- +1 SET DIC=50.7
- SET DA=PSOPOST(52.41,DA,DR,"I")
- SET DR=.02
- SET DIQ(0)="IE"
- DO EN^DIQ1
- +2 SET ^TMP($JOB,LIST,DFN,IEN,8)=^TMP($JOB,LIST,DFN,IEN,8)_"^"_PSOPOST(50.7,DA,DR,"I")_"^"_PSOPOST(50.7,DA,DR,"E")
- +3 QUIT
