PSX550.m

PSX550 ;BIR/DB - API for file 550 ;24 Feb 2006

 ;;2.0;CMOP;**61**;11 Apr 97;Build 1

PSX(PSXIEN,PSXTXT,LIST) ;

 ;PSXIEN -CMOP system internal entry number (optional)

 ;PSXTXT - Free Text CMOP system name (optional)

 ;LIST: Subscript name used in ^TMP global [REQUIRED]

 I $G(PSXIEN)="",$G(PSXTXT)="" Q

 I $G(LIST)="" Q

 K ^TMP($J,LIST),DA,^UTILITY("DIQ1",$J),DIQ

 I $G(PSXIEN)]"" S DA=PSXIEN I '$D(^PSX(550,DA,0)) G RET0

 I $G(PSXTXT)'="",$G(PSXIEN)'>0,'$D(^PSX(550,"B",PSXTXT)) G RET0

 I $G(PSXTXT)'="",$G(DA)'>0 S DA=$O(^PSX(550,"B",PSXTXT,0))

 K ^UTILITY("DIQ1",$J),DIC S DIC=550,DR=".01;1",DIQ(0)="IE" D EN^DIQ1

 I '$D(^UTILITY("DIQ1",$J)) G RET0

 S:$G(PSXTXT)="" PSXTXT=^UTILITY("DIQ1",$J,550,DA,.01,"E")

 S ^TMP($J,LIST,1)=$G(^UTILITY("DIQ1",$J,550,DA,1,"I"))

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

 S ^TMP($J,LIST,"B",PSXTXT,DA)=""

 Q

 K PSXIEN,DA,X,PSXTXT,DR,DIC Q

RET0 ;return no data

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

 Q

PSX550    ;BIR/DB - API for file 550 ;24 Feb 2006

 +1       ;;2.0;CMOP;**61**;11 Apr 97;Build 1

PSX(PSXIEN,PSXTXT,LIST) ;

 +1       ;PSXIEN -CMOP system internal entry number (optional)

 +2       ;PSXTXT - Free Text CMOP system name (optional)

 +3       ;LIST: Subscript name used in ^TMP global [REQUIRED]

 +4        IF $GET(PSXIEN)=""

               IF $GET(PSXTXT)=""

                   QUIT 

 +5        IF $GET(LIST)=""

               QUIT 

 +6        KILL ^TMP($JOB,LIST),DA,^UTILITY("DIQ1",$JOB),DIQ

 +7        IF $GET(PSXIEN)]""

               SET DA=PSXIEN

               IF '$DATA(^PSX(550,DA,0))

                   GOTO RET0

 +8        IF $GET(PSXTXT)'=""

               IF $GET(PSXIEN)'>0

                   IF '$DATA(^PSX(550,"B",PSXTXT))

                       GOTO RET0

 +9        IF $GET(PSXTXT)'=""

               IF $GET(DA)'>0

                   SET DA=$ORDER(^PSX(550,"B",PSXTXT,0))

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

           SET DIC=550

           SET DR=".01;1"

           SET DIQ(0)="IE"

           DO EN^DIQ1

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

               GOTO RET0

 +12       IF $GET(PSXTXT)=""

               SET PSXTXT=^UTILITY("DIQ1",$JOB,550,DA,.01,"E")

 +13       SET ^TMP($JOB,LIST,1)=$GET(^UTILITY("DIQ1",$JOB,550,DA,1,"I"))

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

 +15       SET ^TMP($JOB,LIST,"B",PSXTXT,DA)=""

 +16       QUIT 

 +17       KILL PSXIEN,DA,X,PSXTXT,DR,DIC

           QUIT 

RET0      ;return no data

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

           QUIT 

 +2        QUIT