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
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSX550   1046     printed  Sep 23, 2025@19:19:16                                                                                                                                                                                                      Page 2
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