PSS59P7.m

PSS59P7 ;BHM/DB - Pharmacy System File API ;1 JUL 05

 ;;1.0;PHARMACY DATA MANAGEMENT;**101,108**;9/30/97;Build 10

PSS(PSSIEN,PSSTXT,LIST) ;SRS 3.2.78

 ;PSSIEN - INTERNAL ENTRY NUMBER (optional)

 ;PSSTXT - Free Text site name (optional)

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

 N X,DA,DR,DIC,DIQ

 I $G(PSSIEN)="",$G(PSSTXT)="" Q

 I $G(LIST)="" Q

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

 I $G(PSSIEN)]"" S DA=PSSIEN I '$D(^PS(59.7,DA,0)) G RET0

 I $G(PSSTXT)'="",$G(PSSIEN)'>0,'$D(^PS(59.7,"B",PSSTXT)) G RET0

 I $G(PSSTXT)'="",$G(DA)'>0 S DA=$O(^PS(59.7,"B",PSSTXT,0))

 K ^UTILITY("DIQ1",$J),DIC S DIC=59.7,DR=".01;40.1;49.99;81",DIQ(0)="IE" D EN^DIQ1

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

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

 F X=40.1,49.99,81 S ^TMP($J,LIST,DA,X)=$G(^UTILITY("DIQ1",$J,59.7,DA,X,"I"))

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

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

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

 K PSSIEN,DA,X,PSSTXT,DR,DIC,^UTILITY("DIQ1",$J) Q

RET0 ;return no data

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSS59P7   1295     printed  Apr 09, 2024@21:33:32                                                                                                                                                                                                     Page 2

PSS59P7   ;BHM/DB - Pharmacy System File API ;1 JUL 05

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**101,108**;9/30/97;Build 10

PSS(PSSIEN,PSSTXT,LIST) ;SRS 3.2.78

 +1       ;PSSIEN - INTERNAL ENTRY NUMBER (optional)

 +2       ;PSSTXT - Free Text site name (optional)

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

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

 +5        IF $GET(PSSIEN)=""

               IF $GET(PSSTXT)=""

                   QUIT 

 +6        IF $GET(LIST)=""

               QUIT 

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

 +8        IF $GET(PSSIEN)]""

               SET DA=PSSIEN

               IF '$DATA(^PS(59.7,DA,0))

                   GOTO RET0

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

               IF $GET(PSSIEN)'>0

                   IF '$DATA(^PS(59.7,"B",PSSTXT))

                       GOTO RET0

 +10       IF $GET(PSSTXT)'=""

               IF $GET(DA)'>0

                   SET DA=$ORDER(^PS(59.7,"B",PSSTXT,0))

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

           SET DIC=59.7

           SET DR=".01;40.1;49.99;81"

           SET DIQ(0)="IE"

           DO EN^DIQ1

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

               GOTO RET0

 +13       if $GET(PSSTXT)=""

               SET PSSTXT=^UTILITY("DIQ1",$JOB,59.7,DA,.01,"E")

 +14       FOR X=40.1,49.99,81

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

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

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

 +17       SET ^TMP($JOB,LIST,"B",PSSTXT,DA)=""

 +18       KILL PSSIEN,DA,X,PSSTXT,DR,DIC,^UTILITY("DIQ1",$JOB)

           QUIT 

RET0      ;return no data

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

           QUIT