PSO5291.m

PSO5291 ;BHM/DB - TPB Eligibility file API ; 18 JUL 05

 ;;7.0;OUTPATIENT PHARMACY;**213**;DEC 1997

PSO(PSOIEN,PSOTXT,LIST) ;SDD 3.2.21

 ;PSOIEN - IEN

 ;PSOTXT - FREE TEXT ENTRY

 Q:$G(LIST)=""

 N DA,DIC,DR,DIQ,X K ^TMP($J,LIST),^UTILITY("DIQ1",$J)

 I $G(PSOIEN)="",$G(PSOTXT)="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q

 I $G(PSOIEN)]"" D  G Q

 .I '$G(^PS(52.91,PSOIEN,0)) S ^TMP($J,LIST,PSOIEN,0)="-1^NO DATA FOUND" Q

 .S DA=PSOIEN D TMP

 I $G(PSOTXT)]"" D  G Q

 .S DA=$O(^DPT("B",PSOTXT,0)) I DA="" S ^TMP($J,LIST,PSOTXT,0)="-1^NO DATA FOUND" Q

 .D TMP

 Q

TMP S ^TMP($J,LIST,DA,0)=1

 S DIC=52.91,DR=".01:11",DIQ(0)="IE"

 D EN^DIQ1 I '$D(^UTILITY("DIQ1",$J)) S ^TMP($J,LIST,DA,0)="-1^NO DATA FOUND" Q

 F X=.01,1,2,3,4,5,6,7,8,9,10,11 D

 .S ^TMP($J,LIST,DA,X)=$G(^UTILITY("DIQ1",$J,52.91,DA,X,"I"))

 .S ^TMP($J,LIST,DA,X)=$S($G(^UTILITY("DIQ1",$J,52.91,DA,X,"E"))'="":^TMP($J,LIST,DA,X)_"^"_$G(^UTILITY("DIQ1",$J,52.91,DA,X,"E")),1:"")

 S DFN=$G(^UTILITY("DIQ1",$J,52.91,DA,.01,"I")),^TMP($J,LIST,"B",DFN,DA)=""

 K ^UTILITY("DIQ1",$J)

 Q

Q K DA,DFN,DIC,DIQ,DR,LIST,PSOIEN,PSOTXT,X Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSO5291   1105     printed  Apr 09, 2024@21:32:29                                                                                                                                                                                                     Page 2

PSO5291   ;BHM/DB - TPB Eligibility file API ; 18 JUL 05

 +1       ;;7.0;OUTPATIENT PHARMACY;**213**;DEC 1997

PSO(PSOIEN,PSOTXT,LIST) ;SDD 3.2.21

 +1       ;PSOIEN - IEN

 +2       ;PSOTXT - FREE TEXT ENTRY

 +3        if $GET(LIST)=""

               QUIT 

 +4        NEW DA,DIC,DR,DIQ,X

           KILL ^TMP($JOB,LIST),^UTILITY("DIQ1",$JOB)

 +5        IF $GET(PSOIEN)=""

               IF $GET(PSOTXT)=""

                   SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"

                   QUIT 

 +6        IF $GET(PSOIEN)]""

               Begin DoDot:1

 +7                IF '$GET(^PS(52.91,PSOIEN,0))

                       SET ^TMP($JOB,LIST,PSOIEN,0)="-1^NO DATA FOUND"

                       QUIT 

 +8                SET DA=PSOIEN

                   DO TMP

               End DoDot:1

               GOTO Q

 +9        IF $GET(PSOTXT)]""

               Begin DoDot:1

 +10               SET DA=$ORDER(^DPT("B",PSOTXT,0))

                   IF DA=""

                       SET ^TMP($JOB,LIST,PSOTXT,0)="-1^NO DATA FOUND"

                       QUIT 

 +11               DO TMP

               End DoDot:1

               GOTO Q

 +12       QUIT 

TMP        SET ^TMP($JOB,LIST,DA,0)=1

 +1        SET DIC=52.91

           SET DR=".01:11"

           SET DIQ(0)="IE"

 +2        DO EN^DIQ1

           IF '$DATA(^UTILITY("DIQ1",$JOB))

               SET ^TMP($JOB,LIST,DA,0)="-1^NO DATA FOUND"

               QUIT 

 +3        FOR X=.01,1,2,3,4,5,6,7,8,9,10,11

               Begin DoDot:1

 +4                SET ^TMP($JOB,LIST,DA,X)=$GET(^UTILITY("DIQ1",$JOB,52.91,DA,X,"I"))

 +5                SET ^TMP($JOB,LIST,DA,X)=$SELECT($GET(^UTILITY("DIQ1",$JOB,52.91,DA,X,"E"))'="":^TMP($JOB,LIST,DA,X)_"^"_$GET(^UTILITY("DIQ1",$JOB,52.91,DA,X,"E")),1:"")

               End DoDot:1

 +6        SET DFN=$GET(^UTILITY("DIQ1",$JOB,52.91,DA,.01,"I"))

           SET ^TMP($JOB,LIST,"B",DFN,DA)=""

 +7        KILL ^UTILITY("DIQ1",$JOB)

 +8        QUIT 

Q          KILL DA,DFN,DIC,DIQ,DR,LIST,PSOIEN,PSOTXT,X

           QUIT