- PSS50A1 ;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 DD(50 supported by DBIA 999
- ;External reference to PS(50.605 supported by DBIA 2138
- ;
- SETDRG ;
- 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),62.01)=$G(^TMP("PSSP50",$J,50,PSS(1),62.01,"I"))
- S ^TMP($J,LIST,+PSS(1),62.02)=$S($G(^TMP("PSSP50",$J,50,PSS(1),62.02,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),62.02,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),62.02,"E")))
- S ^TMP($J,LIST,+PSS(1),62.03)=$S($G(^TMP("PSSP50",$J,50,PSS(1),62.03,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),62.03,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),62.03,"E")))
- S ^TMP($J,LIST,+PSS(1),62.04)=$G(^TMP("PSSP50",$J,50,PSS(1),62.04,"I"))
- S ^TMP($J,LIST,+PSS(1),62.05)=$S($G(^TMP("PSSP50",$J,50,PSS(1),62.05,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),62.05,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),62.05,"E")))
- S ^TMP($J,LIST,+PSS(1),905)=$S($G(^TMP("PSSP50",$J,50,PSS(1),905,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),905,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),905,"E")))
- Q
- LOOP ;
- N PSS50DD,PSS50ERR,PSS8UDS D FIELD^DID(50,62.03,"Z","POINTER","PSS50DD","PSS50ERR") S PSS8UDS=$G(PSS50DD("POINTER"))
- 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 SETDRGL
- .S PSSENCT=PSSENCT+1
- S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
- Q
- SETDRGL ;
- N PSSZNODE,PSS8ND
- S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS8ND=$G(^(8))
- S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
- S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
- S ^TMP($J,LIST,+PSS(1),62.01)=$P(PSS8ND,"^")
- S ^TMP($J,LIST,+PSS(1),62.02)=$S($P(PSS8ND,"^",2):$P(PSS8ND,"^",2)_"^"_$P($G(^PS(51.2,+$P(PSS8ND,"^",2),0)),"^"),1:"")
- N PSS8UD S PSS8UD=$P(PSS8ND,"^",3) D
- .I PSS8UD'="",PSS8UDS'="",PSS8UDS[(PSS8UD_":") S ^TMP($J,LIST,+PSS(1),62.03)=PSS8UD_"^"_$P($E(PSS8UDS,$F(PSS8UDS,(PSS8UD_":")),999),";") Q
- .S ^TMP($J,LIST,+PSS(1),62.03)=""
- S ^TMP($J,LIST,+PSS(1),62.04)=$P(PSS8ND,"^",4)
- S ^TMP($J,LIST,+PSS(1),62.05)=$S($P(PSS8ND,"^",5):$P(PSS8ND,"^",5)_"^"_$P($G(^PSDRUG(+$P(PSS8ND,"^",5),0)),"^"),1:"")
- S ^TMP($J,LIST,+PSS(1),905)=$S($P(PSS8ND,"^",6):$P(PSS8ND,"^",6)_"^"_$P($G(^PSDRUG(+$P(PSS8ND,"^",6),0)),"^"),1:"")
- Q
- LABEL ;
- ;PSSIEN - IEN of entry in 50
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- ; piece being returned.
- N DIERR,ZZERR,SCR,PSS,PSSMLCT,PSSP50
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I +$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,,"") D
- .K ^TMP("DIERR",$J)
- .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .K PSS50 D GETS^DIQ(50,+PSSIEN2,".01;25;51;100;101;102","IE","PSS50") S PSS(1)=0
- .F S PSS(1)=$O(PSS50(50,PSS(1))) Q:'PSS(1) D SLABEL
- K ^TMP("DILIST",$J)
- Q
- SLABEL ;
- S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS50(50,PSS(1),.01,"I"))
- S ^TMP($J,LIST,"B",$G(PSS50(50,PSS(1),.01,"I")),+PSS(1))=""
- S ^TMP($J,LIST,+PSS(1),25)=$S($G(PSS50(50,PSS(1),25,"I"))="":"",1:$G(PSS50(50,PSS(1),25,"I"))_"^"_$G(PSS50(50,PSS(1),25,"E"))_"^"_$P($G(^PS(50.605,+PSS50(50,PSS(1),25,"I"),0)),"^",2))
- S ^TMP($J,LIST,+PSS(1),51)=$S($G(PSS50(50,PSS(1),51,"I"))="":"",1:$G(PSS50(50,PSS(1),51,"I"))_"^"_$G(PSS50(50,PSS(1),51,"E")))
- S ^TMP($J,LIST,+PSS(1),100)=$S($G(PSS50(50,PSS(1),100,"I"))="":"",1:$G(PSS50(50,PSS(1),100,"I"))_"^"_$G(PSS50(50,PSS(1),100,"E")))
- S ^TMP($J,LIST,+PSS(1),101)=$G(PSS50(50,PSS(1),101,"E"))
- S ^TMP($J,LIST,+PSS(1),102)=$G(PSS50(50,PSS(1),102,"E"))
- Q
- SORT ;
- ;PSSIEN - IEN of entry in 50
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,NAME field (#.01),IEN)=""
- N DIERR,ZZERR,SCR,PSS,PSSMLCT,PSSP50
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I +$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,,"") D
- .K ^TMP("DIERR",$J)
- .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .K PSS50 D GETS^DIQ(50,+PSSIEN2,".01","IE","PSS50") S PSS(1)=0
- .F S PSS(1)=$O(PSS50(50,PSS(1))) Q:'PSS(1) D
- ..S ^TMP($J,LIST,$G(PSS50(50,PSS(1),.01,"I")),+PSS(1))=""
- K ^TMP("DILIST",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50A1 4887 printed Jan 18, 2025@03:30:22 Page 2
- PSS50A1 ;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 DD(50 supported by DBIA 999
- +3 ;External reference to PS(50.605 supported by DBIA 2138
- +4 ;
- SETDRG ;
- +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),62.01)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),62.01,"I"))
- +4 SET ^TMP($JOB,LIST,+PSS(1),62.02)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),62.02,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),62.02,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),62.02,"E")))
- +5 SET ^TMP($JOB,LIST,+PSS(1),62.03)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),62.03,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),62.03,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),62.03,"E")))
- +6 SET ^TMP($JOB,LIST,+PSS(1),62.04)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),62.04,"I"))
- +7 SET ^TMP($JOB,LIST,+PSS(1),62.05)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),62.05,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),62.05,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),62.05,"E")))
- +8 SET ^TMP($JOB,LIST,+PSS(1),905)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),905,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),905,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),905,"E")))
- +9 QUIT
- LOOP ;
- +1 NEW PSS50DD,PSS50ERR,PSS8UDS
- DO FIELD^DID(50,62.03,"Z","POINTER","PSS50DD","PSS50ERR")
- SET PSS8UDS=$GET(PSS50DD("POINTER"))
- +2 NEW PSSENCT
- +3 SET PSSENCT=0
- +4 SET PSS(1)=0
- FOR
- SET PSS(1)=$ORDER(^PSDRUG(PSS(1)))
- if 'PSS(1)
- QUIT
- Begin DoDot:1
- +5 IF $PIECE($GET(^PSDRUG(PSS(1),0)),"^")=""
- QUIT
- +6 IF $GET(PSSFL)
- IF $PIECE($GET(^PSDRUG(PSS(1),"I")),"^")
- IF $PIECE($GET(^("I")),"^")'>PSSFL
- QUIT
- +7 IF $GET(PSSRTOI)=1
- IF '$PIECE($GET(^PSDRUG(PSS(1),2)),"^")
- QUIT
- +8 ;Naked reference below refers to ^PSDRUG(PSS(1),2)
- +9 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
- +10 IF $GET(PSSPK)]""
- IF 'PSSZ5
- QUIT
- +11 DO SETDRGL
- +12 SET PSSENCT=PSSENCT+1
- End DoDot:1
- +13 SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSSENCT):$GET(PSSENCT),1:"-1^NO DATA FOUND")
- +14 QUIT
- SETDRGL ;
- +1 NEW PSSZNODE,PSS8ND
- +2 SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))
- SET PSS8ND=$GET(^(8))
- +3 SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")
- +4 SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""
- +5 SET ^TMP($JOB,LIST,+PSS(1),62.01)=$PIECE(PSS8ND,"^")
- +6 SET ^TMP($JOB,LIST,+PSS(1),62.02)=$SELECT($PIECE(PSS8ND,"^",2):$PIECE(PSS8ND,"^",2)_"^"_$PIECE($GET(^PS(51.2,+$PIECE(PSS8ND,"^",2),0)),"^"),1:"")
- +7 NEW PSS8UD
- SET PSS8UD=$PIECE(PSS8ND,"^",3)
- Begin DoDot:1
- +8 IF PSS8UD'=""
- IF PSS8UDS'=""
- IF PSS8UDS[(PSS8UD_":")
- SET ^TMP($JOB,LIST,+PSS(1),62.03)=PSS8UD_"^"_$PIECE($EXTRACT(PSS8UDS,$FIND(PSS8UDS,(PSS8UD_":")),999),";")
- QUIT
- +9 SET ^TMP($JOB,LIST,+PSS(1),62.03)=""
- End DoDot:1
- +10 SET ^TMP($JOB,LIST,+PSS(1),62.04)=$PIECE(PSS8ND,"^",4)
- +11 SET ^TMP($JOB,LIST,+PSS(1),62.05)=$SELECT($PIECE(PSS8ND,"^",5):$PIECE(PSS8ND,"^",5)_"^"_$PIECE($GET(^PSDRUG(+$PIECE(PSS8ND,"^",5),0)),"^"),1:"")
- +12 SET ^TMP($JOB,LIST,+PSS(1),905)=$SELECT($PIECE(PSS8ND,"^",6):$PIECE(PSS8ND,"^",6)_"^"_$PIECE($GET(^PSDRUG(+$PIECE(PSS8ND,"^",6),0)),"^"),1:"")
- +13 QUIT
- LABEL ;
- +1 ;PSSIEN - IEN of entry in 50
- +2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- +3 ; piece being returned.
- +4 NEW DIERR,ZZERR,SCR,PSS,PSSMLCT,PSSP50
- +5 IF $GET(LIST)']""
- QUIT
- +6 KILL ^TMP($JOB,LIST)
- +7 IF +$GET(PSSIEN)'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +8 IF +$GET(PSSIEN)>0
- NEW PSSIEN2
- SET PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,,"")
- Begin DoDot:1
- +9 KILL ^TMP("DIERR",$JOB)
- +10 IF +PSSIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +11 SET ^TMP($JOB,LIST,0)=1
- +12 KILL PSS50
- DO GETS^DIQ(50,+PSSIEN2,".01;25;51;100;101;102","IE","PSS50")
- SET PSS(1)=0
- +13 FOR
- SET PSS(1)=$ORDER(PSS50(50,PSS(1)))
- if 'PSS(1)
- QUIT
- DO SLABEL
- End DoDot:1
- +14 KILL ^TMP("DILIST",$JOB)
- +15 QUIT
- SLABEL ;
- +1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(PSS50(50,PSS(1),.01,"I"))
- +2 SET ^TMP($JOB,LIST,"B",$GET(PSS50(50,PSS(1),.01,"I")),+PSS(1))=""
- +3 SET ^TMP($JOB,LIST,+PSS(1),25)=$SELECT($GET(PSS50(50,PSS(1),25,"I"))="":"",1:$GET(PSS50(50,PSS(1),25,"I"))_"^"_$GET(PSS50(50,PSS(1),25,"E"))_"^"_$PIECE($GET(^PS(50.605,+PSS50(50,PSS(1),25,"I"),0)),"^",2))
- +4 SET ^TMP($JOB,LIST,+PSS(1),51)=$SELECT($GET(PSS50(50,PSS(1),51,"I"))="":"",1:$GET(PSS50(50,PSS(1),51,"I"))_"^"_$GET(PSS50(50,PSS(1),51,"E")))
- +5 SET ^TMP($JOB,LIST,+PSS(1),100)=$SELECT($GET(PSS50(50,PSS(1),100,"I"))="":"",1:$GET(PSS50(50,PSS(1),100,"I"))_"^"_$GET(PSS50(50,PSS(1),100,"E")))
- +6 SET ^TMP($JOB,LIST,+PSS(1),101)=$GET(PSS50(50,PSS(1),101,"E"))
- +7 SET ^TMP($JOB,LIST,+PSS(1),102)=$GET(PSS50(50,PSS(1),102,"E"))
- +8 QUIT
- SORT ;
- +1 ;PSSIEN - IEN of entry in 50
- +2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,NAME field (#.01),IEN)=""
- +3 NEW DIERR,ZZERR,SCR,PSS,PSSMLCT,PSSP50
- +4 IF $GET(LIST)']""
- QUIT
- +5 KILL ^TMP($JOB,LIST)
- +6 IF +$GET(PSSIEN)'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +7 IF +$GET(PSSIEN)>0
- NEW PSSIEN2
- SET PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,,"")
- Begin DoDot:1
- +8 KILL ^TMP("DIERR",$JOB)
- +9 IF +PSSIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +10 SET ^TMP($JOB,LIST,0)=1
- +11 KILL PSS50
- DO GETS^DIQ(50,+PSSIEN2,".01","IE","PSS50")
- SET PSS(1)=0
- +12 FOR
- SET PSS(1)=$ORDER(PSS50(50,PSS(1)))
- if 'PSS(1)
- QUIT
- Begin DoDot:2
- +13 SET ^TMP($JOB,LIST,$GET(PSS50(50,PSS(1),.01,"I")),+PSS(1))=""
- End DoDot:2
- End DoDot:1
- +14 KILL ^TMP("DILIST",$JOB)
- +15 QUIT