[613] | 1 | PSS50F1 ;BIR/RTR - API FOR INFORMATION FROM FILE 50
|
---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
|
---|
| 3 | ;
|
---|
| 4 | ;Reference to ^PS(50.605 is supported by DBIA #2138
|
---|
| 5 | ;
|
---|
| 6 | LIST ;
|
---|
| 7 | ;PSSFT - Free Text name in 50
|
---|
| 8 | ;PSSFL - Inactive flag - "" - All entries
|
---|
| 9 | ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
|
---|
| 10 | ;PSSD - Index used in the lookup in the format B^C
|
---|
| 11 | ;PSSPK - Application Package's Use - "" - All entries
|
---|
| 12 | ; Alphabetic codes that represent the DHCP packages that consider this drug to be
|
---|
| 13 | ; part of their formulary.
|
---|
| 14 | ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
|
---|
| 15 | ; piece being returned.
|
---|
| 16 | N DIERR,ZZERR,PSSP50,SCR,PSS,CNT,PSSXSUB,PSSLUPAR,PSSLUPP,PSSSCRN,PSSENCT
|
---|
| 17 | I $G(LIST)']"" Q
|
---|
| 18 | K ^TMP($J,LIST)
|
---|
| 19 | I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
| 20 | S SCR("S")=""
|
---|
| 21 | S PSSXSUB="" D SETXSUB
|
---|
| 22 | S PSSENCT=0
|
---|
| 23 | I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
|
---|
| 24 | I $G(PSSFT)]"" D
|
---|
| 25 | .I PSSFT["??" D LOOP Q
|
---|
| 26 | .K ^TMP("DILIST",$J),^TMP($J,"PSSLDONE")
|
---|
| 27 | .S PSSSCRN=$G(SCR("S")) S:$G(PSSD)="" PSSD="B" D PARSE^PSS50F(PSSD) I '$O(PSSLUPAR(0)) Q
|
---|
| 28 | .S PSSLUPP=0 F S PSSLUPP=$O(PSSLUPAR(PSSLUPP)) Q:'PSSLUPP D
|
---|
| 29 | ..S SCR("S")=$G(PSSSCRN)
|
---|
| 30 | ..D FIND^DIC(50,,"@;.01","QPB"_$S($P(PSSLUPAR(PSSLUPP),"^",2):"X",1:""),PSSFT,,PSSLUPAR(PSSLUPP),SCR("S"),,"")
|
---|
| 31 | ..I +$G(^TMP("DILIST",$J,0))=0 Q
|
---|
| 32 | ..I +^TMP("DILIST",$J,0)>0 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
|
---|
| 33 | ...S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) I '$D(^TMP($J,"PSSLDONE",PSSIEN)) S ^TMP($J,"PSSLDONE",PSSIEN)="" D
|
---|
| 34 | ....K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;100;2.1","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
|
---|
| 35 | ....F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETLIST
|
---|
| 36 | S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
|
---|
| 37 | K ^TMP("DILIST",$J),^TMP("PSSP50",$J),^TMP($J,"PSSLDONE")
|
---|
| 38 | Q
|
---|
| 39 | SETLIST ;
|
---|
| 40 | S PSSENCT=PSSENCT+1
|
---|
| 41 | S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
|
---|
| 42 | ;S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
|
---|
| 43 | ;S ^TMP($J,LIST,$S($G(PSSD)]"":$P(PSSD,"^"),1:"B"),^TMP("PSSP50",$J,50,PSS(1),.01,"I"),+PSS(1))=""
|
---|
| 44 | S ^TMP($J,LIST,$S($G(PSSXSUB)'="":$G(PSSXSUB),1:"B"),^TMP("PSSP50",$J,50,PSS(1),.01,"I"),+PSS(1))=""
|
---|
| 45 | S ^TMP($J,LIST,+PSS(1),2.1)=$S($G(^TMP("PSSP50",$J,50,PSS(1),2.1,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),2.1,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),2.1,"E")))
|
---|
| 46 | I $P($G(^TMP($J,LIST,+PSS(1),2.1)),"^") D
|
---|
| 47 | .N PSSADDF S PSSADDF=$$SETDF^PSS50AQM($P(^TMP($J,LIST,+PSS(1),2.1),"^")) S ^TMP($J,LIST,+PSS(1),2.1)=^TMP($J,LIST,+PSS(1),2.1)_$S($P($G(PSSADDF),"^")>0:"^"_$P($G(PSSADDF),"^",3)_"^"_$P($G(PSSADDF),"^",4),1:"")
|
---|
| 48 | S ^TMP($J,LIST,+PSS(1),100)=$S($G(^TMP("PSSP50",$J,50,PSS(1),100,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),100,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),100,"E")))
|
---|
| 49 | Q
|
---|
| 50 | LOOP ;
|
---|
| 51 | S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
|
---|
| 52 | .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
|
---|
| 53 | .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
|
---|
| 54 | .;I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
|
---|
| 55 | .;Naked reference below refers to ^PSDRUG(PSS(1),2)
|
---|
| 56 | .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
|
---|
| 57 | .I $G(PSSPK)]"",'PSSZ5 Q
|
---|
| 58 | .D SETLISTL
|
---|
| 59 | .S PSSENCT=PSSENCT+1
|
---|
| 60 | Q
|
---|
| 61 | SETLISTL ;
|
---|
| 62 | N PSSZNODE,PSS2NODE S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS2NODE=$G(^(2))
|
---|
| 63 | S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
|
---|
| 64 | S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
|
---|
| 65 | S ^TMP($J,LIST,+PSS(1),2.1)=$S('$P(PSS2NODE,"^"):"",1:$P(PSS2NODE,"^")_"^"_$P($G(^PS(50.7,+$P(PSS2NODE,"^"),0)),"^"))
|
---|
| 66 | N PSSADDF S PSSADDF=$P($G(^PS(50.7,+$P($G(^TMP($J,LIST,+PSS(1),2.1)),"^"),0)),"^",2) I PSSADDF>0 D
|
---|
| 67 | .S ^TMP($J,LIST,+PSS(1),2.1)=^TMP($J,LIST,+PSS(1),2.1)_"^"_PSSADDF_"^"_$P($G(^PS(50.606,PSSADDF,0)),"^")
|
---|
| 68 | N Y S Y=$P($G(^PSDRUG(PSS(1),"I")),"^") D
|
---|
| 69 | .I Y S ^TMP($J,LIST,+PSS(1),100)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,+PSS(1),100)=^TMP($J,LIST,+PSS(1),100)_"^"_$G(Y) Q
|
---|
| 70 | .S ^TMP($J,LIST,+PSS(1),100)=""
|
---|
| 71 | Q
|
---|
| 72 | SETXSUB ;
|
---|
| 73 | Q:$G(PSSD)=""
|
---|
| 74 | N PSSLSX,PSSLSXCT,PSSLCNT,PSSDSUB
|
---|
| 75 | S PSSLSXCT=0
|
---|
| 76 | F PSSLSX=1:1:$L(PSSD) I $E(PSSD,PSSLSX)="^" S PSSLSXCT=PSSLSXCT+1
|
---|
| 77 | S PSSLSXCT=PSSLSXCT+1
|
---|
| 78 | S PSSLCNT=0 F PSSLSX=1:1:PSSLSXCT S PSSDSUB=$P(PSSD,"^",PSSLSX) Q:PSSLCNT>1 S PSSXSUB=$S(PSSDSUB'="":PSSDSUB,PSSXSUB'="":PSSXSUB,1:"") S:PSSDSUB'="" PSSLCNT=PSSLCNT+1
|
---|
| 79 | I PSSLCNT>1 S PSSXSUB=""
|
---|
| 80 | Q
|
---|
| 81 | LOOKUP ;
|
---|
| 82 | ;PSSFT - Free Text value that could be the NAME field (#.01), IEN, VA PRODUCT NAME field (#21), NATIONAL DRUG CLASS field (#25),
|
---|
| 83 | ; or SYNONYM (#.01) mutiple of the DRUG file (#50).
|
---|
| 84 | ;PSSFL - Inactive flag - "" - All entries
|
---|
| 85 | ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
|
---|
| 86 | ;PSSPK - Application Package's Use - "" - All entries
|
---|
| 87 | ; Alphabetic codes that represent the DHCP packages that consider this drug to be
|
---|
| 88 | ; part of their formulary.
|
---|
| 89 | ;PSSRTOI - 1 - only drugs with data in the PHARMACY ORDERABLE ITEM field (#2.1) will be returned.
|
---|
| 90 | ;PSSIFCAP - 1 - only drugs with no data in the IFCAP ITEM NUMBER multiple (#441) will be returned.
|
---|
| 91 | ;PSSCMOP - 1 - only drugs with no data in the CMOP ID field (#27) will be returned.
|
---|
| 92 | ;PSSD - Index used in the lookup in the format B^C.
|
---|
| 93 | ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
|
---|
| 94 | ; piece being returned.
|
---|
| 95 | N PSSLKIEN,PSSLKSUB,PSSENCT,SCR,PSSXSUB,CNT,PSS,DIERR
|
---|
| 96 | I $G(LIST)']"" Q
|
---|
| 97 | K ^TMP($J,LIST)
|
---|
| 98 | I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
| 99 | S PSSENCT=0
|
---|
| 100 | I PSSFT["??" D LOOPLK Q
|
---|
| 101 | S SCR("S")=""
|
---|
| 102 | I $G(PSSCMOP)=1 D
|
---|
| 103 | .S SCR("S")="I $P($G(^(""ND"")),""^"",10)=""""" Q
|
---|
| 104 | I $G(PSSIFCAP)=1 D
|
---|
| 105 | .I SCR("S")="" S SCR("S")="I '$O(^PSDRUG(+Y,441,0))" Q
|
---|
| 106 | .S SCR("S")=SCR("S")_" I '$O(^PSDRUG(+Y,441,0))"
|
---|
| 107 | I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN
|
---|
| 108 | I PSSFT'="",PSSFT?1"`"1N.N D S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND") Q
|
---|
| 109 | .N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A",PSSFT,,SCR("S"),"")
|
---|
| 110 | .K ^TMP("DIERR",$J)
|
---|
| 111 | .I +PSSIEN2'>0 Q
|
---|
| 112 | .I $P($G(^PSDRUG(+PSSIEN2,0)),"^")="" Q
|
---|
| 113 | .S PSSLKIEN=+PSSIEN2,PSSLKSUB="B"
|
---|
| 114 | .D LOOKSET
|
---|
| 115 | I $G(PSSFT)]"" D
|
---|
| 116 | .N PSSLUPAR,PSSLUPP,PSSSCRN
|
---|
| 117 | .S PSSXSUB="" D SETXSUB S PSSLKSUB=$S($G(PSSXSUB)'="":$G(PSSXSUB),1:"B")
|
---|
| 118 | .K ^TMP("DILIST",$J),^TMP($J,"PSSLDONE")
|
---|
| 119 | .S PSSSCRN=$G(SCR("S")) S:$G(PSSD)="" PSSD="B" D PARSE^PSS50F(PSSD) I '$O(PSSLUPAR(0)) Q
|
---|
| 120 | .S PSSLUPP=0 F S PSSLUPP=$O(PSSLUPAR(PSSLUPP)) Q:'PSSLUPP D
|
---|
| 121 | ..S SCR("S")=PSSSCRN
|
---|
| 122 | ..D FIND^DIC(50,,"@;.01","QPB"_$S($P(PSSLUPAR(PSSLUPP),"^",2):"X",1:""),PSSFT,,PSSLUPAR(PSSLUPP),SCR("S"),,"")
|
---|
| 123 | ..I +$G(^TMP("DILIST",$J,0))=0 Q
|
---|
| 124 | ..I +^TMP("DILIST",$J,0)>0 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
|
---|
| 125 | ...S PSSLKIEN=+^TMP("DILIST",$J,PSSXX,0) I $P($G(^PSDRUG(PSSLKIEN,0)),"^")'="",'$D(^TMP($J,"PSSLDONE",PSSLKIEN)) S ^TMP($J,"PSSLDONE",PSSLKIEN)="" D LOOKSET
|
---|
| 126 | S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
|
---|
| 127 | K ^TMP("DILIST",$J),^TMP($J,"PSSLDONE")
|
---|
| 128 | Q
|
---|
| 129 | LOOKSET ;
|
---|
| 130 | ;PSSLKIEN = ien from File 50
|
---|
| 131 | ;PSSLKSUB = Subscript for the cross reference return
|
---|
| 132 | N PSSLKNAM,PSSLKND,PSSLKZER
|
---|
| 133 | S PSSLKNAM=$P($G(^PSDRUG(PSSLKIEN,0)),"^"),PSSLKND=$G(^("ND")),PSSLKZER=$G(^(0)) Q:PSSLKNAM=""
|
---|
| 134 | S ^TMP($J,LIST,PSSLKIEN,.01)=PSSLKNAM
|
---|
| 135 | S ^TMP($J,LIST,PSSLKSUB,PSSLKNAM,PSSLKIEN)=""
|
---|
| 136 | S PSSENCT=PSSENCT+1
|
---|
| 137 | S ^TMP($J,LIST,PSSLKIEN,25)=$S($P(PSSLKND,"^",6):$P(PSSLKND,"^",6)_"^"_$P($G(^PS(50.605,+$P(PSSLKND,"^",6),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
|
---|
| 138 | N Y S Y=$P($G(^PSDRUG(PSSLKIEN,"I")),"^") D
|
---|
| 139 | .I Y S ^TMP($J,LIST,PSSLKIEN,100)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,PSSLKIEN,100)=^TMP($J,LIST,PSSLKIEN,100)_"^"_$G(Y) Q
|
---|
| 140 | .S ^TMP($J,LIST,PSSLKIEN,100)=""
|
---|
| 141 | S ^TMP($J,LIST,PSSLKIEN,101)=$P(PSSLKZER,"^",10)
|
---|
| 142 | Q
|
---|
| 143 | LOOPLK ;
|
---|
| 144 | S PSSLKSUB="B"
|
---|
| 145 | S PSSLKIEN=0 F S PSSLKIEN=$O(^PSDRUG(PSSLKIEN)) Q:'PSSLKIEN D
|
---|
| 146 | .I $P($G(^PSDRUG(PSSLKIEN,0)),"^")="" Q
|
---|
| 147 | .I $G(PSSCMOP)=1,$P($G(^PSDRUG(PSSLKIEN,"ND")),"^",10)'="" Q
|
---|
| 148 | .I $G(PSSIFCAP)=1,$O(^PSDRUG(PSSLKIEN,441,0)) Q
|
---|
| 149 | .I $G(PSSFL),$P($G(^PSDRUG(PSSLKIEN,"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
|
---|
| 150 | .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSSLKIEN,2)),"^") Q
|
---|
| 151 | .I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^PSDRUG(PSSLKIEN,2)),"^",3)[$E(PSSPK,PSSZ6) S PSSZ5=1
|
---|
| 152 | .I $G(PSSPK)]"",'PSSZ5 Q
|
---|
| 153 | .D LOOKSET
|
---|
| 154 | S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
|
---|
| 155 | Q
|
---|
| 156 | ;
|
---|
| 157 | SETSCRN ;Set Screen
|
---|
| 158 | I +$G(PSSFL)>0 D
|
---|
| 159 | .I SCR("S")]"" S SCR("S")=SCR("S")_" S PSS5ND=$P($G(^PSDRUG(+Y,""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)" Q
|
---|
| 160 | .S SCR("S")="S PSS5ND=$P($G(^PSDRUG(+Y,""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)"
|
---|
| 161 | I $G(PSSRTOI)=1 D
|
---|
| 162 | .I SCR("S")]"" S SCR("S")=SCR("S")_" I $P($G(^PSDRUG(+Y,2)),""^"")" Q
|
---|
| 163 | .S SCR("S")="I $P($G(^PSDRUG(+Y,2)),""^"")"
|
---|
| 164 | I $G(PSSPK)]"" D
|
---|
| 165 | .I SCR("S")]"" S SCR("S")=SCR("S")_" S PSSZ3=0 F PSSZ4=1:1:$L(PSSPK) Q:PSSZ3 I $P($G(^PSDRUG(+Y,2)),""^"",3)[$E(PSSPK,PSSZ4) S PSSZ3=1" Q
|
---|
| 166 | .S SCR("S")="S PSSZ3=0 F PSSZ4=1:1:$L(PSSPK) Q:PSSZ3 I $P($G(^PSDRUG(+Y,2)),""^"",3)[$E(PSSPK,PSSZ4) S PSSZ3=1"
|
---|
| 167 | ;I $G(PSSPK)]"" S SCR("S")=$S(SCR("S")]"":SCR("S")_" I $G(^PSDRUG(+Y,2)),$P($G(^PSDRUG(+Y,2)),""^"",3)[PSSPK",1:"I $G(^PSDRUG(+Y,2)),$P($G(^PSDRUG(+Y,2)),""^"",3)[PSSPK")
|
---|
| 168 | Q
|
---|