PSO5241.m

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