PSO53.m

PSO53 ;BHM/DB - API FOR PATIENT STATUS FILE ;8 JUN 05

 ;;7.0;OUTPATIENT PHARMACY;**213,245**;DEC 1997;Build 20

PSO(PSOIEN,PSOTXT,LIST) ;

 N DA,DIQ,DR,X,I,DIC

 I $G(LIST)'="" K ^TMP($J,LIST)

 I $G(PSOIEN)="",$G(PSOTXT)="",$G(LIST)="" Q

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

 I $G(LIST)="" Q

 I $G(PSOIEN)'>0,$G(PSOTXT)'="" S DA=$O(^PS(53,"B",PSOTXT,0)) I DA'>0 S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q

 I $G(DA)'>0,$G(PSOIEN)>0 S DA=PSOIEN

 K ^UTILITY("DIQ1",$J),DIC S DIC=53,DR=".01;2;3;4;5;6;15;16",DIQ(0)="IE" D EN^DIQ1

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

 F X=.01,2,3,4,5,6,15,16 S ^TMP($J,LIST,DA,X)=^UTILITY("DIQ1",$J,53,DA,X,"I")

 S PSOTXT=$G(^UTILITY("DIQ1",$J,53,DA,.01,"E"))

 F X=5,6,15,16 S ^TMP($J,LIST,DA,X)=$S(^UTILITY("DIQ1",$J,53,DA,X,"E")'="":^TMP($J,LIST,DA,X)_"^"_^UTILITY("DIQ1",$J,53,DA,X,"E"),1:"")

 K ^UTILITY("DIQ1",$J) S ^TMP($J,LIST,"B",PSOTXT,DA)="",^TMP($J,LIST,DA,0)=$G(^TMP($J,LIST,DA,0))+1

 K DA,DIC,DIQ,DA,DR,X Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSO53   1042     printed  Apr 09, 2024@21:32:24                                                                                                                                                                                                       Page 2

PSO53     ;BHM/DB - API FOR PATIENT STATUS FILE ;8 JUN 05

 +1       ;;7.0;OUTPATIENT PHARMACY;**213,245**;DEC 1997;Build 20

PSO(PSOIEN,PSOTXT,LIST) ;

 +1        NEW DA,DIQ,DR,X,I,DIC

 +2        IF $GET(LIST)'=""

               KILL ^TMP($JOB,LIST)

 +3        IF $GET(PSOIEN)=""

               IF $GET(PSOTXT)=""

                   IF $GET(LIST)=""

                       QUIT 

 +4        IF $GET(PSOIEN)=""

               IF $GET(PSOTXT)=""

                   IF $GET(LIST)'=""

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

                       QUIT 

 +5        IF $GET(LIST)=""

               QUIT 

 +6        IF $GET(PSOIEN)'>0

               IF $GET(PSOTXT)'=""

                   SET DA=$ORDER(^PS(53,"B",PSOTXT,0))

                   IF DA'>0

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

                       QUIT 

 +7        IF $GET(DA)'>0

               IF $GET(PSOIEN)>0

                   SET DA=PSOIEN

 +8        KILL ^UTILITY("DIQ1",$JOB),DIC

           SET DIC=53

           SET DR=".01;2;3;4;5;6;15;16"

           SET DIQ(0)="IE"

           DO EN^DIQ1

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

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

               QUIT 

 +10       FOR X=.01,2,3,4,5,6,15,16

               SET ^TMP($JOB,LIST,DA,X)=^UTILITY("DIQ1",$JOB,53,DA,X,"I")

 +11       SET PSOTXT=$GET(^UTILITY("DIQ1",$JOB,53,DA,.01,"E"))

 +12       FOR X=5,6,15,16

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

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

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

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

 +14       KILL DA,DIC,DIQ,DA,DR,X

           QUIT