Routine: PSS50NDF

PSS50NDF ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03

 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97

 ;External reference to PS(50.605 supported by DBIA 2138

SETND ;

 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))

 S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""

 S ^TMP($J,LIST,+PSS(1),20)=$S($G(^TMP("PSSP50",$J,50,PSS(1),20,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),20,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),20,"E")))

 S ^TMP($J,LIST,+PSS(1),21)=$G(^TMP("PSSP50",$J,50,PSS(1),21,"I"))

 S ^TMP($J,LIST,+PSS(1),22)=$S($G(^TMP("PSSP50",$J,50,PSS(1),22,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),22,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),22,"E")))

 S ^TMP($J,LIST,+PSS(1),23)=$S($G(^TMP("PSSP50",$J,50,PSS(1),23,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),23,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),23,"E")))

 S ^TMP($J,LIST,+PSS(1),24)=$S($G(^TMP("PSSP50",$J,50,PSS(1),24,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),24,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),24,"E")))

 N PSS50NCL S PSS50NCL=$S($G(^TMP("PSSP50",$J,50,PSS(1),25,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),25,"I")))

 S ^TMP($J,LIST,+PSS(1),25)=$S($G(^TMP("PSSP50",$J,50,PSS(1),25,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),25,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),25,"E")))

 I PSS50NCL S ^TMP($J,LIST,+PSS(1),25)=^TMP($J,LIST,+PSS(1),25)_"^"_$P($G(^PS(50.605,PSS50NCL,0)),"^",2)

 S ^TMP($J,LIST,+PSS(1),27)=$G(^TMP("PSSP50",$J,50,PSS(1),27,"I"))

 S ^TMP($J,LIST,+PSS(1),29)=$S($G(^TMP("PSSP50",$J,50,PSS(1),29,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),29,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),29,"E")))

LOOP ;

 N PSSENCT

 S PSSENCT=0

 S PSS(1)=0 F  S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1)  D

 .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q

 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q

 .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q

 .;Naked reference below refers to ^PSDRUG(PSS(1),2)

 .I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5  I $P($G(^(2)),"^",3)[$E(PSSPK,PSSZ6) S PSSZ5=1

 .I $G(PSSPK)]"",'PSSZ5 Q

 .D SETNDL

 .S PSSENCT=PSSENCT+1

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

SETNDL ;

 N PSSZNODE,PSS50NDN

 S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50NDN=$G(^("ND"))

 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")

 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""

 N PSS50NDA D GETS^DIQ(50,+PSS(1),"20;21;22;23;24;25;27;29","IE","PSS50NDA")

 S ^TMP($J,LIST,+PSS(1),20)=$S($G(PSS50NDA(50,+PSS(1)_",",20,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",20,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",20,"E")))

 S ^TMP($J,LIST,+PSS(1),21)=$G(PSS50NDA(50,+PSS(1)_",",21,"I"))

 S ^TMP($J,LIST,+PSS(1),22)=$S($G(PSS50NDA(50,+PSS(1)_",",22,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",22,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",22,"E")))

 S ^TMP($J,LIST,+PSS(1),23)=$S($G(PSS50NDA(50,+PSS(1)_",",23,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",23,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",23,"E")))

 S ^TMP($J,LIST,+PSS(1),24)=$S($G(PSS50NDA(50,+PSS(1)_",",24,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",24,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",24,"E")))

 N PSS50NLL S PSS50NLL=$S($G(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",25,"I")))

 S ^TMP($J,LIST,+PSS(1),25)=$S($G(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",25,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",25,"E")))

 I PSS50NLL S ^TMP($J,LIST,+PSS(1),25)=^TMP($J,LIST,+PSS(1),25)_"^"_$P($G(^PS(50.605,PSS50NLL,0)),"^",2)

 S ^TMP($J,LIST,+PSS(1),27)=$G(PSS50NDA(50,+PSS(1)_",",27,"I"))

 S ^TMP($J,LIST,+PSS(1),29)=$S($G(PSS50NDA(50,+PSS(1)_",",29,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",29,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",29,"E")))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50NDF   3771     printed  Mar 13, 2025@21:34:24                                                                                                                                                                                                    Page 2

PSS50NDF  ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97

 +2       ;External reference to PS(50.605 supported by DBIA 2138

 +3       ;

SETND     ;

 +1        SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I"))

 +2        SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSSP50",$JOB,50,PSS(1),.01,"I")),+PSS(1))=""

 +3        SET ^TMP($JOB,LIST,+PSS(1),20)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),20,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),20,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),20,"E")))

 +4        SET ^TMP($JOB,LIST,+PSS(1),21)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),21,"I"))

 +5        SET ^TMP($JOB,LIST,+PSS(1),22)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),22,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),22,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),22,"E")))

 +6        SET ^TMP($JOB,LIST,+PSS(1),23)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),23,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),23,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),23,"E")))

 +7        SET ^TMP($JOB,LIST,+PSS(1),24)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),24,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),24,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),24,"E")))

 +8        NEW PSS50NCL

           SET PSS50NCL=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"I")))

 +9        SET ^TMP($JOB,LIST,+PSS(1),25)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),25,"E")))

 +10       IF PSS50NCL

               SET ^TMP($JOB,LIST,+PSS(1),25)=^TMP($JOB,LIST,+PSS(1),25)_"^"_$PIECE($GET(^PS(50.605,PSS50NCL,0)),"^",2)

 +11       SET ^TMP($JOB,LIST,+PSS(1),27)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),27,"I"))

 +12       SET ^TMP($JOB,LIST,+PSS(1),29)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),29,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),29,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),29,"E")))

 +13       QUIT

LOOP      ;

 +1        NEW PSSENCT

 +2        SET PSSENCT=0

 +3        SET PSS(1)=0

FOR

               SET PSS(1)=$ORDER(^PSDRUG(PSS(1)))

               if 'PSS(1)

                   QUIT

               Begin DoDot:1

 +4                IF $PIECE($GET(^PSDRUG(PSS(1),0)),"^")=""

                       QUIT

 +5                IF $GET(PSSFL)

                       IF $PIECE($GET(^PSDRUG(PSS(1),"I")),"^")

                           IF $PIECE($GET(^("I")),"^")'>PSSFL

                               QUIT

 +6                IF $GET(PSSRTOI)=1

                       IF '$PIECE($GET(^PSDRUG(PSS(1),2)),"^")

                           QUIT

 +7       ;Naked reference below refers to ^PSDRUG(PSS(1),2)

 +8                IF $GET(PSSPK)]""

                       NEW PSSZ5,PSSZ6

                       SET PSSZ5=0

                       FOR PSSZ6=1:1:$LENGTH(PSSPK)

                           if PSSZ5

                               QUIT

                           IF $PIECE($GET(^(2)),"^",3)[$EXTRACT(PSSPK,PSSZ6)

                               SET PSSZ5=1

 +9                IF $GET(PSSPK)]""

                       IF 'PSSZ5

                           QUIT

 +10               DO SETNDL

 +11               SET PSSENCT=PSSENCT+1

               End DoDot:1

 +12       SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSSENCT):$GET(PSSENCT),1:"-1^NO DATA FOUND")

 +13       QUIT

SETNDL    ;

 +1        NEW PSSZNODE,PSS50NDN

 +2        SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))

           SET PSS50NDN=$GET(^("ND"))

 +3        SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")

 +4        SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""

 +5        NEW PSS50NDA

           DO GETS^DIQ(50,+PSS(1),"20;21;22;23;24;25;27;29","IE","PSS50NDA")

 +6        SET ^TMP($JOB,LIST,+PSS(1),20)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",20,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",20,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",20,"E")))

 +7        SET ^TMP($JOB,LIST,+PSS(1),21)=$GET(PSS50NDA(50,+PSS(1)_",",21,"I"))

 +8        SET ^TMP($JOB,LIST,+PSS(1),22)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",22,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",22,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",22,"E")))

 +9        SET ^TMP($JOB,LIST,+PSS(1),23)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",23,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",23,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",23,"E")))

 +10       SET ^TMP($JOB,LIST,+PSS(1),24)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",24,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",24,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",24,"E")))

 +11       NEW PSS50NLL

           SET PSS50NLL=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",25,"I")))

 +12       SET ^TMP($JOB,LIST,+PSS(1),25)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",25,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",25,"E")))

 +13       IF PSS50NLL

               SET ^TMP($JOB,LIST,+PSS(1),25)=^TMP($JOB,LIST,+PSS(1),25)_"^"_$PIECE($GET(^PS(50.605,PSS50NLL,0)),"^",2)

 +14       SET ^TMP($JOB,LIST,+PSS(1),27)=$GET(PSS50NDA(50,+PSS(1)_",",27,"I"))

 +15       SET ^TMP($JOB,LIST,+PSS(1),29)=$SELECT($GET(PSS50NDA(50,+PSS(1)_",",29,"I"))="":"",1:$GET(PSS50NDA(50,+PSS(1)_",",29,"I"))_"^"_$GET(PSS50NDA(50,+PSS(1)_",",29,"E")))

 +16       QUIT

PSS50NDF.m