- PSS50LAB ;BIR/LDT - API FOR LAB INFORMATION FROM FILE 50; 5 Sep 03
- ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
- ;
- LAB ;
- ;PSSIEN - IEN of entry in 50
- ;PSSFT - Free Text name in 50
- ;PSSFL - Inactive flag - "" - All entries
- ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- ;PSSPK - Application Package's Use - "" - All entries
- ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- ; part of their formulary.
- ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
- ;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,PSSP50,SCR,PSS,PSSMLCT
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- S SCR("S")=""
- I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
- I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
- .K ^TMP("DIERR",$J)
- .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;17.2:17.6","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
- .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETLAB
- I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I $G(PSSFT)]"" D
- .I PSSFT["??" D LOOP Q
- .K ^TMP("DILIST",$J)
- .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
- .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
- ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
- ..K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;17.2:17.6","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
- ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETLAB
- K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
- Q
- ;
- SETLAB ;
- 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),17.2)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.2,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),17.2,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.2,"E")))
- S ^TMP($J,LIST,+PSS(1),17.3)=$G(^TMP("PSSP50",$J,50,PSS(1),17.3,"I"))
- S ^TMP($J,LIST,+PSS(1),17.4)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.4,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),17.4,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.4,"E")))
- S ^TMP($J,LIST,+PSS(1),17.5)=$G(^TMP("PSSP50",$J,50,PSS(1),17.5,"I"))
- S ^TMP($J,LIST,+PSS(1),17.6)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.6,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),17.6,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.6,"E")))
- Q
- ;
- LOOP ;
- N PSS50D12,PSS50E12,PSS176D D FIELD^DID(50,17.6,"Z","POINTER","PSS50D12","PSS50E12") S PSS176D=$G(PSS50D12("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 SETLABL
- .S PSSENCT=PSSENCT+1
- S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
- Q
- SETLABL ;
- N PSSZNODE,PSS50CL,PSS50CL1
- S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50CL=$G(^("CLOZ")),PSS50CL1=$G(^("CLOZ1"))
- S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
- S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
- N PSSCLZAR D GETS^DIQ(50,+PSS(1),"17.2;17.4","IE","PSSCLZAR")
- S ^TMP($J,LIST,+PSS(1),17.2)=$S($G(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))="":"",1:$G(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))_"^"_$G(PSSCLZAR(50,+PSS(1)_",",17.2,"E")))
- S ^TMP($J,LIST,+PSS(1),17.3)=$P(PSS50CL,"^",2)
- S ^TMP($J,LIST,+PSS(1),17.4)=$S($G(PSSCLZAR(50,+PSS(1)_",",17.4,"I"))="":"",1:$G(PSSCLZAR(50,+PSS(1)_",",17.4,"I"))_"^"_$G(PSSCLZAR(50,+PSS(1)_",",17.4,"E")))
- S ^TMP($J,LIST,+PSS(1),17.5)=$P(PSS50CL1,"^")
- N PSS176 S PSS176=$P(PSS50CL1,"^",2) D
- .I PSS176'="",PSS176D'="",PSS176D[(PSS176_":") S ^TMP($J,LIST,+PSS(1),17.6)=PSS176_"^"_$P($E(PSS176D,$F(PSS176D,(PSS176_":")),999),";") Q
- .S ^TMP($J,LIST,+PSS(1),17.6)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50LAB 4601 printed Feb 18, 2025@23:55:57 Page 2
- PSS50LAB ;BIR/LDT - API FOR LAB INFORMATION FROM FILE 50; 5 Sep 03
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
- +2 ;
- LAB ;
- +1 ;PSSIEN - IEN of entry in 50
- +2 ;PSSFT - Free Text name in 50
- +3 ;PSSFL - Inactive flag - "" - All entries
- +4 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- +5 ;PSSPK - Application Package's Use - "" - All entries
- +6 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
- +7 ; part of their formulary.
- +8 ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
- +9 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
- +10 ; piece being returned.
- +11 NEW DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
- +12 IF $GET(LIST)']""
- QUIT
- +13 KILL ^TMP($JOB,LIST)
- +14 IF +$GET(PSSIEN)'>0
- IF ($GET(PSSFT)']"")
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +15 SET SCR("S")=""
- +16 IF +$GET(PSSFL)>0!($GET(PSSPK)]"")!($GET(PSSRTOI)=1)
- NEW PSS5ND,PSSZ3,PSSZ4
- DO SETSCRN^PSS50A
- +17 IF +$GET(PSSIEN)>0
- NEW PSSIEN2
- SET PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"")
- Begin DoDot:1
- +18 KILL ^TMP("DIERR",$JOB)
- +19 IF +PSSIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +20 SET ^TMP($JOB,LIST,0)=1
- +21 KILL ^TMP("PSSP50",$JOB)
- DO GETS^DIQ(50,+PSSIEN2,".01;17.2:17.6","IE","^TMP(""PSSP50"",$J)")
- SET PSS(1)=0
- +22 FOR
- SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
- if 'PSS(1)
- QUIT
- DO SETLAB
- End DoDot:1
- KILL ^TMP("PSSP50",$JOB)
- QUIT
- +23 IF $GET(PSSIEN)'=""
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +24 IF $GET(PSSFT)]""
- Begin DoDot:1
- +25 IF PSSFT["??"
- DO LOOP
- QUIT
- +26 KILL ^TMP("DILIST",$JOB)
- +27 DO FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
- +28 IF +$GET(^TMP("DILIST",$JOB,0))=0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +29 IF +^TMP("DILIST",$JOB,0)>0
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- NEW PSSXX
- SET PSSXX=0
- FOR
- SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
- if 'PSSXX
- QUIT
- Begin DoDot:2
- +30 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
- +31 KILL ^TMP("PSSP50",$JOB)
- DO GETS^DIQ(50,+PSSIEN,".01;17.2:17.6","IE","^TMP(""PSSP50"",$J)")
- SET PSS(1)=0
- +32 FOR
- SET PSS(1)=$ORDER(^TMP("PSSP50",$JOB,50,PSS(1)))
- if 'PSS(1)
- QUIT
- DO SETLAB
- End DoDot:2
- End DoDot:1
- +33 KILL ^TMP("DILIST",$JOB),^TMP("PSSP50",$JOB)
- +34 QUIT
- +35 ;
- SETLAB ;
- +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),17.2)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),17.2,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.2,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.2,"E")))
- +4 SET ^TMP($JOB,LIST,+PSS(1),17.3)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.3,"I"))
- +5 SET ^TMP($JOB,LIST,+PSS(1),17.4)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),17.4,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.4,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.4,"E")))
- +6 SET ^TMP($JOB,LIST,+PSS(1),17.5)=$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.5,"I"))
- +7 SET ^TMP($JOB,LIST,+PSS(1),17.6)=$SELECT($GET(^TMP("PSSP50",$JOB,50,PSS(1),17.6,"I"))="":"",1:$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.6,"I"))_"^"_$GET(^TMP("PSSP50",$JOB,50,PSS(1),17.6,"E")))
- +8 QUIT
- +9 ;
- LOOP ;
- +1 NEW PSS50D12,PSS50E12,PSS176D
- DO FIELD^DID(50,17.6,"Z","POINTER","PSS50D12","PSS50E12")
- SET PSS176D=$GET(PSS50D12("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 SETLABL
- +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
- SETLABL ;
- +1 NEW PSSZNODE,PSS50CL,PSS50CL1
- +2 SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))
- SET PSS50CL=$GET(^("CLOZ"))
- SET PSS50CL1=$GET(^("CLOZ1"))
- +3 SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")
- +4 SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""
- +5 NEW PSSCLZAR
- DO GETS^DIQ(50,+PSS(1),"17.2;17.4","IE","PSSCLZAR")
- +6 SET ^TMP($JOB,LIST,+PSS(1),17.2)=$SELECT($GET(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))="":"",1:$GET(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))_"^"_$GET(PSSCLZAR(50,+PSS(1)_",",17.2,"E")))
- +7 SET ^TMP($JOB,LIST,+PSS(1),17.3)=$PIECE(PSS50CL,"^",2)
- +8 SET ^TMP($JOB,LIST,+PSS(1),17.4)=$SELECT($GET(PSSCLZAR(50,+PSS(1)_",",17.4,"I"))="":"",1:$GET(PSSCLZAR(50,+PSS(1)_",",17.4,"I"))_"^"_$GET(PSSCLZAR(50,+PSS(1)_",",17.4,"E")))
- +9 SET ^TMP($JOB,LIST,+PSS(1),17.5)=$PIECE(PSS50CL1,"^")
- +10 NEW PSS176
- SET PSS176=$PIECE(PSS50CL1,"^",2)
- Begin DoDot:1
- +11 IF PSS176'=""
- IF PSS176D'=""
- IF PSS176D[(PSS176_":")
- SET ^TMP($JOB,LIST,+PSS(1),17.6)=PSS176_"^"_$PIECE($EXTRACT(PSS176D,$FIND(PSS176D,(PSS176_":")),999),";")
- QUIT
- +12 SET ^TMP($JOB,LIST,+PSS(1),17.6)=""
- End DoDot:1
- +13 QUIT
