- PSS551 ;BHM/DB - API FOR PHARMACY PATIENT FILE ;15 JUN 05
- ;;1.0;PHARMACY DATA MANAGEMENT;**108,118,133,169,173**;9/30/97;Build 9
- ;DFN: IEN of Patient [REQUIRED]
- ;PO: Order # [optional]
- ;PSDATE: Start Date [optional]
- ;PEDATE: End Date [optional]
- ;If a start date is sent, an end date must also be sent
- ;LIST: Subscript name used in ^TMP global [REQUIRED]
- N PSSPO,PSSIEN,DA,DR,DIC,PSS,CNT1,X,PSSTMP
- I $G(LIST)="" Q
- K ^TMP($J,LIST)
- I $G(DFN)="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- S PSSIEN=$G(DFN),PSSPO=$G(PO) S ^TMP($J,LIST,0)=0
- I $G(PSSPO)>0,$G(PSSIEN)>0 S DA=PSSIEN,(IEN,DA(55.06))=PSSPO G DIQ431
- I $G(PSSPO)="",$G(PSDATE)'="",$G(PEDATE)'="" S PSDATE=$S('$P(PSDATE,".",2):PSDATE_.000001,1:PSDATE),PEDATE=$S('$P($G(PEDATE),".",2):PEDATE_.999999,1:$G(PEDATE)) N PSS56 G DT431
- I $G(PSSPO)="" N PSSPO1 G LOOP431
- Q
- LOOP431 S (PSSPO1,PSSPO)=0 F S PSSPO1=$O(^PS(55,DFN,5,"B",PSSPO1)) Q:PSSPO1'>0 F S PSSPO=$O(^PS(55,DFN,5,"B",PSSPO1,PSSPO)) Q:PSSPO'>0 S PO=PSSPO D DIQ431
- Q
- DIQ431 ;
- I '$D(^PS(55,DFN,5,PO,0)) Q
- S PSSIEN=PO_","_DFN_"," K DIQ
- D GETS^DIQ(55.06,PSSIEN,".01;.5;1;2*;3;4;5;6;7;10;11;12;26;27;27.1;28;34;66;109","IE","^TMP(""PSS5506"",$J)")
- F X=.01,.5,1,3,4,5,6,7,10,11,12,26,27,27.1,28,34,66,109 S ^TMP($J,LIST,+PSSPO,X)=$G(^TMP("PSS5506",$J,55.06,PSSIEN,X,"I"))
- F X=.5,1,3,4,5,6,7,10,27,27.1,28,34 S ^TMP($J,LIST,+PSSPO,X)=$S($G(^TMP("PSS5506",$J,55.06,PSSIEN,X,"E"))'="":^TMP($J,LIST,+PSSPO,X)_"^"_$G(^TMP("PSS5506",$J,55.06,PSSIEN,X,"E")),1:"")
- S PSSTMP=$P($G(^PS(55,DFN,5,PO,.2)),U) S ^TMP($J,LIST,IEN,108)=$S($G(PSSTMP)="":"",1:$$ORDITEM^PSS55(+PSSTMP))
- S (PSS(1),CNT1)=0 F S PSS(1)=$O(^TMP("PSS5506",$J,55.07,PSS(1))) Q:'PSS(1) D
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.11)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.11,"I"))
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.12)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.12,"I"))
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.01)=$S($G(^TMP("PSS5506",$J,55.07,PSS(1),.01,"E"))'="":$G(^TMP("PSS5506",$J,55.07,PSS(1),.01,"I"))_"^"_$G(^TMP("PSS5506",$J,55.07,PSS(1),.01,"E")),1:"")
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.02)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.02,"I"))
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.03)=$S($G(^TMP("PSS5506",$J,55.07,PSS(1),.03,"E"))'="":$G(^TMP("PSS5506",$J,55.07,PSS(1),.03,"I"))_"^"_$G(^TMP("PSS5506",$J,55.07,PSS(1),.03,"E")),1:"")
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.04)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.04,"I"))
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.05)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.05,"I"))
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.06)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.06,"I"))
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.07)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.07,"I"))
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.08)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.08,"I"))
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.09)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.09,"I"))
- .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.1)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.1,"I"))
- .S CNT1=CNT1+1
- K ^TMP("PSS5506",$J),PSS(1) S ^TMP($J,LIST,"B",+PSSPO)=""
- S ^TMP($J,LIST,0)=^TMP($J,LIST,0)+1
- S ^TMP($J,LIST,+PSSPO,"DDRUG",0)=$S(CNT1=0:"-1^NO DATA FOUND",1:CNT1)
- S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
- Q
- DT431 F S PSDATE=$O(^PS(55,DFN,5,"AUS",PSDATE)) Q:((+$G(PEDATE)>0)&(PSDATE>$G(PEDATE))) Q:PSDATE'>0 D
- .S PSS56=0 F S PSS56=$O(^PS(55,DFN,5,"AUS",PSDATE,PSS56)) Q:PSS56'>0 S (PSSPO,PO)=PSS56 D DIQ431
- S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
- K CNT1,LIST,DA,DFN,DIC,DIQ,DR,IEN,PEDATE,PO,PSDATE,PSS,PSS56,PSSPO,PSSPO1,X Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS551 3629 printed Jan 18, 2025@03:30:59 Page 2
- PSS551 ;BHM/DB - API FOR PHARMACY PATIENT FILE ;15 JUN 05
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**108,118,133,169,173**;9/30/97;Build 9
- +2 ;DFN: IEN of Patient [REQUIRED]
- +3 ;PO: Order # [optional]
- +4 ;PSDATE: Start Date [optional]
- +5 ;PEDATE: End Date [optional]
- +6 ;If a start date is sent, an end date must also be sent
- +7 ;LIST: Subscript name used in ^TMP global [REQUIRED]
- +8 NEW PSSPO,PSSIEN,DA,DR,DIC,PSS,CNT1,X,PSSTMP
- +9 IF $GET(LIST)=""
- QUIT
- +10 KILL ^TMP($JOB,LIST)
- +11 IF $GET(DFN)=""
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +12 SET PSSIEN=$GET(DFN)
- SET PSSPO=$GET(PO)
- SET ^TMP($JOB,LIST,0)=0
- +13 IF $GET(PSSPO)>0
- IF $GET(PSSIEN)>0
- SET DA=PSSIEN
- SET (IEN,DA(55.06))=PSSPO
- GOTO DIQ431
- +14 IF $GET(PSSPO)=""
- IF $GET(PSDATE)'=""
- IF $GET(PEDATE)'=""
- SET PSDATE=$SELECT('$PIECE(PSDATE,".",2):PSDATE_.000001,1:PSDATE)
- SET PEDATE=$SELECT('$PIECE($GET(PEDATE),".",2):PEDATE_.999999,1:$GET(PEDATE))
- NEW PSS56
- GOTO DT431
- +15 IF $GET(PSSPO)=""
- NEW PSSPO1
- GOTO LOOP431
- +16 QUIT
- LOOP431 SET (PSSPO1,PSSPO)=0
- FOR
- SET PSSPO1=$ORDER(^PS(55,DFN,5,"B",PSSPO1))
- if PSSPO1'>0
- QUIT
- FOR
- SET PSSPO=$ORDER(^PS(55,DFN,5,"B",PSSPO1,PSSPO))
- if PSSPO'>0
- QUIT
- SET PO=PSSPO
- DO DIQ431
- +1 QUIT
- DIQ431 ;
- +1 IF '$DATA(^PS(55,DFN,5,PO,0))
- QUIT
- +2 SET PSSIEN=PO_","_DFN_","
- KILL DIQ
- +3 DO GETS^DIQ(55.06,PSSIEN,".01;.5;1;2*;3;4;5;6;7;10;11;12;26;27;27.1;28;34;66;109","IE","^TMP(""PSS5506"",$J)")
- +4 FOR X=.01,.5,1,3,4,5,6,7,10,11,12,26,27,27.1,28,34,66,109
- SET ^TMP($JOB,LIST,+PSSPO,X)=$GET(^TMP("PSS5506",$JOB,55.06,PSSIEN,X,"I"))
- +5 FOR X=.5,1,3,4,5,6,7,10,27,27.1,28,34
- SET ^TMP($JOB,LIST,+PSSPO,X)=$SELECT($GET(^TMP("PSS5506",$JOB,55.06,PSSIEN,X,"E"))'="":^TMP($JOB,LIST,+PSSPO,X)_"^"_$GET(^TMP("PSS5506",$JOB,55.06,PSSIEN,X,"E")),1:"")
- +6 SET PSSTMP=$PIECE($GET(^PS(55,DFN,5,PO,.2)),U)
- SET ^TMP($JOB,LIST,IEN,108)=$SELECT($GET(PSSTMP)="":"",1:$$ORDITEM^PSS55(+PSSTMP))
- +7 SET (PSS(1),CNT1)=0
- FOR
- SET PSS(1)=$ORDER(^TMP("PSS5506",$JOB,55.07,PSS(1)))
- if 'PSS(1)
- QUIT
- Begin DoDot:1
- +8 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.11)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.11,"I"))
- +9 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.12)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.12,"I"))
- +10 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.01)=$SELECT($GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.01,"E"))'="":$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.01,"I"))_"^"_$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.01,"E")),1:"")
- +11 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.02)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.02,"I"))
- +12 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.03)=$SELECT($GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.03,"E"))'="":$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.03,"I"))_"^"_$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.03,"E")),1:"")
- +13 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.04)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.04,"I"))
- +14 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.05)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.05,"I"))
- +15 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.06)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.06,"I"))
- +16 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.07)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.07,"I"))
- +17 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.08)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.08,"I"))
- +18 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.09)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.09,"I"))
- +19 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.1)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.1,"I"))
- +20 SET CNT1=CNT1+1
- End DoDot:1
- +21 KILL ^TMP("PSS5506",$JOB),PSS(1)
- SET ^TMP($JOB,LIST,"B",+PSSPO)=""
- +22 SET ^TMP($JOB,LIST,0)=^TMP($JOB,LIST,0)+1
- +23 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",0)=$SELECT(CNT1=0:"-1^NO DATA FOUND",1:CNT1)
- +24 SET ^TMP($JOB,LIST,0)=$SELECT(^TMP($JOB,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($JOB,LIST,0))
- +25 QUIT
- DT431 FOR
- SET PSDATE=$ORDER(^PS(55,DFN,5,"AUS",PSDATE))
- if ((+$GET(PEDATE)>0)&(PSDATE>$GET(PEDATE)))
- QUIT
- if PSDATE'>0
- QUIT
- Begin DoDot:1
- +1 SET PSS56=0
- FOR
- SET PSS56=$ORDER(^PS(55,DFN,5,"AUS",PSDATE,PSS56))
- if PSS56'>0
- QUIT
- SET (PSSPO,PO)=PSS56
- DO DIQ431
- End DoDot:1
- +2 SET ^TMP($JOB,LIST,0)=$SELECT(^TMP($JOB,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($JOB,LIST,0))
- +3 KILL CNT1,LIST,DA,DFN,DIC,DIQ,DR,IEN,PEDATE,PO,PSDATE,PSS,PSS56,PSSPO,PSSPO1,X
- QUIT