- PSS55 ;BHM/DB/TSS - API FOR PHARMACY PATIENT FILE ;15 JUN 05
- ;;1.0;PHARMACY DATA MANAGEMENT;**101,108,118,88,133**;9/30/97;Build 1
- ;
- PSS431(DFN,PO,PSDATE,PEDATE,LIST) ;
- G ^PSS551
- PSS432(DFN,PO,LIST) ;SRS 3.2.43.2
- N D0,DA,DR,DIC,IEN,PSSTMP,PSSTMP2
- ;DFN: IEN of Patient [REQUIRED]
- ;PO: Order # IEN [optional] If left blank, all active orders will be returned
- ;LIST: Subscript name used in ^TMP global [REQUIRED]
- N PSSPO,PSSDT,PSSIEN,PSSDATA,PSSQ
- Q:$G(LIST)="" K ^TMP($J,LIST)
- I +$G(DFN)'>0 G NODATA
- S ^TMP($J,LIST,0)=0
- I '$D(^PS(55,DFN,0)) G NODATA
- I $G(PO)'="",$D(^PS(55,DFN,5,PO)) S PSSPO=$P(^PS(55,DFN,5,PO,0),"^") I $G(PSSPO)>0 S (DA(55.06),IEN)=PO G AUS2
- I $G(PO)'="",$G(PSSPO)="" G NODATA
- S PSSDT=0
- AUS ;Loop through stop date/time xref
- F S PSSDT=$O(^PS(55,DFN,5,"AUS",PSSDT)) Q:PSSDT'>0 S PSSIEN=0 D
- .F S PSSIEN=$O(^PS(55,DFN,5,"AUS",PSSDT,PSSIEN)) Q:PSSIEN'>0 D
- ..S (IEN,DA(55.06))=PSSIEN,PSSDATA=$G(^PS(55,DFN,5,PSSIEN,0)) I $P(PSSDATA,"^",9)'="A" Q
- ..D AUSDIQ
- S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
- K PSSIEN,PSSDT,PSSDATA,LIST
- Q
- AUSDIQ K ^UTILITY("DIQ1",$J),DIQ
- S DA=DFN,DIC=55,DR=62,DR(55.06)=".01;.5;1;3;4;5;6;7;9;11;12;26;27;27.1;28",DIQ(0)="IE" D EN^DIQ1
- S PSSPO=$G(^UTILITY("DIQ1",$J,55.06,IEN,.01,"E")) F X=.01,.5,1,3,4,5,6,7,9,11,12,26,27,27.1,28 S ^TMP($J,LIST,IEN,X)=$G(^UTILITY("DIQ1",$J,55.06,IEN,X,"I"))
- F X=.5,1,3,4,5,6,7,9,27,27.1,28 S ^TMP($J,LIST,IEN,X)=$S($G(^UTILITY("DIQ1",$J,55.06,IEN,X,"E"))'="":^TMP($J,LIST,IEN,X)_"^"_$G(^UTILITY("DIQ1",$J,55.06,IEN,X,"E")),1:"")
- S PSSTMP=$P($G(^PS(55,DFN,5,IEN,.2)),U) S ^TMP($J,LIST,IEN,108)=$S($G(PSSTMP)="":"",1:$$ORDITEM(+PSSTMP))
- K ^UTILITY("DIQ1",$J),DIQ
- S ^TMP($J,LIST,"B",IEN)="",^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
- Q
- ORDITEM(PSSTMP) ;
- ;Reference to ^PSNDF(50.606 is supported by DBIA 2174
- S PSSTMP2=$G(^PS(50.7,PSSTMP,0))
- I PSSTMP2'="" S PSSTMP=PSSTMP_U_$P($G(PSSTMP2),U)_U_$P($G(PSSTMP2),U,2)_U_$P($G(^PS(50.606,$P($G(PSSTMP2),U,2),0)),U,1)
- Q PSSTMP
- AUS2 ;one PO
- S PSSQ=1 D AUSDIQ
- S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
- AUSQ K PSSDT,PSSIEN,PSSDATA,PSSPO,LIST,X,PSSQ,DA,DR,DIC Q
- ;
- PSS433(DFN,LIST) ;
- ;DFN: IEN of Patient [REQUIRED]
- ;LIST: Subscript name used in ^TMP global [REQUIRED]
- N X,DA,DR,PSSPO,PSSIEN,D0,IEN,PSSTMP,PSSTMP2
- Q:$G(LIST)="" K ^TMP($J,LIST)
- I $G(DFN)'>0 S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- I '$D(^PS(55,DFN)) G NODATA
- S PSSIEN=0,^TMP($J,LIST,0)=0
- BGN433 S PSSIEN=$O(^PS(55,DFN,5,PSSIEN)) G Q433:PSSIEN'>0 S PSSPO=$P($G(^PS(55,DFN,5,PSSIEN,0)),"^")
- S (IEN,DA(55.06))=PSSIEN,DIC=55,DA=DFN,DR=62,DR(55.06)=".5;9;25;26;34;41;42;70",DIQ(0)="IE" D EN^DIQ1
- F X=.5,9,25,26,34,41,42,70 S ^TMP($J,LIST,+PSSIEN,X)=$G(^UTILITY("DIQ1",$J,55.06,IEN,X,"I"))
- S PSSTMP=$P($G(^PS(55,DFN,5,PSSIEN,.2)),U) S ^TMP($J,LIST,IEN,108)=$S($G(PSSTMP)="":"",1:$$ORDITEM(+PSSTMP))
- F X=.5,9,25,34,70 S ^TMP($J,LIST,+PSSIEN,X)=$S($G(^UTILITY("DIQ1",$J,55.06,IEN,X,"E"))'="":^TMP($J,LIST,+PSSIEN,X)_"^"_$G(^UTILITY("DIQ1",$J,55.06,IEN,X,"E")),1:"")
- S ^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
- S ^TMP($J,LIST,"B",+PSSIEN)=""
- G BGN433
- Q433 K ^UTILITY("DIQ1",$J),PSSIEN,X,DR,DIC,DA,LIST Q
- PSS435(DFN,PO,LIST) ;SRS 3.2.43.5
- N D0,DA,DIC,DR,IEN,X,PSSPO,PSSDATA,PSSIEN,PSSDT,PSSTMP,PSSTMP2,PSSSTAT
- ;DFN: IEN of Patient [REQUIRED]
- ;PO: Order # [optional] If left blank, all active orders will be returned.
- ;LIST: Subscript name used in ^TMP global [REQUIRED]
- ;Active hyperal orders utilizing "AIT" cross reference
- Q:$G(LIST)="" K ^TMP($J,LIST)
- I $G(DFN)'>0 S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- I '$D(^PS(55,DFN,"IV","AIT","H")) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- S PSSDT=0,^TMP($J,LIST,0)=0
- AIT ;loop trough AIT xref
- S PSSDT=$O(^PS(55,DFN,"IV","AIT","H",PSSDT)) G AITQ:PSSDT'>0 S PSSIEN=0
- AIT1 S PSSIEN=$O(^PS(55,DFN,"IV","AIT","H",PSSDT,PSSIEN)) G AIT:PSSIEN'>0
- S PSSDATA=$G(^PS(55,DFN,"IV",PSSIEN,0)),PSSSTAT=$P($G(PSSDATA),"^",17) I PSSSTAT'="A",$G(PO)'>0 G AIT1
- I +$G(PO)>0 G AIT1:PSSIEN'=PO
- S PSSPO=$P(PSSDATA,"^",1),^TMP($J,LIST,"B",+PSSIEN)=""
- AITDIQ K ^UTILITY("DIQ1",$J) S DA=DFN,(IEN,DA(55.01))=PSSIEN,DIC=55,DR=100,DIQ(0)="IE",DR(55.01)=".01;.02;.03;.04;.06;.08;.09;.12;.17;.24;9;31;100;104;106;108;110;112;120;121;132" D EN^DIQ1
- F X=.01,.02,.03,.04,.06,.08,.09,.12,.17,.24,9,31,100,104,106,108,110,112,120,121,132 S ^TMP($J,LIST,PSSPO,X)=$G(^UTILITY("DIQ1",$J,55.01,IEN,X,"I"))
- F X=.02,.03,.04,.06,9,100,106,108,112,120,121,132 S ^TMP($J,LIST,PSSPO,X)=$S($G(^UTILITY("DIQ1",$J,55.01,IEN,X,"E"))'="":^TMP($J,LIST,PSSPO,X)_"^"_$G(^UTILITY("DIQ1",$J,55.01,IEN,X,"E")),1:"")
- S PSSTMP=$P($G(^PS(55,DFN,"IV",PSSIEN,.2)),U) S ^TMP($J,LIST,IEN,130)=$S($G(PSSTMP)="":"",1:$$ORDITEM(+PSSTMP))
- K ^UTILITY("DIQ1",$J)
- S ^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
- G AIT1
- AITQ I $G(^TMP($J,LIST,0))=0 K ^TMP($J,LIST) S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
- K PSSIEN,PSSDT,PSSSTAT,PSSDATA,PO,X,LIST Q
- ;
- PSS436(DFN,ORDER,LIST) ;SRS 3.2.43.6
- N D0,IEN,X,PSSTMP,PSSTMP2,DA,PSSLOOP,PSSPO,DIC,DR,PSSTMP,PSSA,PSSS,PSSDATA
- ;DFN: IEN of Patient [REQUIRED]
- ;ORDER: ORDER NUMBER [REQUIRED]
- ;LIST: Subscript name used in ^TMP global [REQUIRED]
- ;Active IV AD nodes
- K PSSLOOP Q:$G(LIST)="" K ^TMP($J,LIST) I $G(DFN)'>0 S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- I '$D(^PS(55,DFN)) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- K ^TMP($J,LIST) I $G(ORDER)="" S PSSLOOP=1 S ORDER=0 G LOOP436
- I $G(ORDER)'="" S PSSPO=$O(^PS(55,DFN,"IV","B",ORDER,0)) G PSS436Q:$G(PSSPO)'>0 G DIQ436
- LOOP436 S ORDER=$O(^PS(55,DFN,"IV","B",ORDER)) G PSS436Q:ORDER'>0 S PSSPO=$O(^PS(55,DFN,"IV","B",ORDER,0))
- DIQ436 K DA,DR S DA=DFN,(IEN,DA(55.01))=PSSPO,DIC=55,DR=100
- S DR(55.01)=".01;.02;.03;.04;.06;.08;.09;.12;.17;.24;9;31;100;104;106;108;110;112;120;121;132;147"
- S DIQ(0)="IE" D EN^DIQ1 I '$D(^UTILITY("DIQ1",$J)) G NODATA
- F X=.01,.02,.03,.04,.06,.08,.09,.12,.17,.24,9,31,100,104,106,108,110,112,120,121,132,147 S ^TMP($J,LIST,PSSPO,X)=$G(^UTILITY("DIQ1",$J,55.01,IEN,X,"I"))
- F X=.02,.03,.04,.06,9,100,106,108,112,120,121,132,147 S ^TMP($J,LIST,PSSPO,X)=$S($G(^UTILITY("DIQ1",$J,55.01,IEN,X,"E"))'="":^TMP($J,LIST,PSSPO,X)_"^"_$G(^UTILITY("DIQ1",$J,55.01,IEN,X,"E")),1:"")
- S PSSTMP=$P($G(^PS(55,DFN,"IV",PSSPO,.2)),U) S ^TMP($J,LIST,IEN,130)=$S($G(PSSTMP)="":"",1:$$ORDITEM(+PSSTMP))
- S ^TMP($J,LIST,"B",PSSPO)="",PSSA=0,^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
- S ^TMP($J,LIST,PSSPO,"ADD",0)=0
- PSSA S PSSA=$O(^PS(55,DFN,"IV",PSSPO,"AD",PSSA)) I PSSA'>0 S PSSS=0 S ^TMP($J,LIST,PSSPO,"SOL",0)=0 G PSSS
- S PSSDATA=$G(^PS(55,DFN,"IV",PSSPO,"AD",PSSA,0)),X1=$P(PSSDATA,"^"),X2=$P(PSSDATA,"^",2),X3=$P(PSSDATA,"^",3)
- S ^TMP($J,LIST,PSSPO,"ADD",PSSA,.01)=X1_"^"_$P($G(^PS(52.6,X1,0)),"^")
- S ^TMP($J,LIST,PSSPO,"ADD",PSSA,.02)=X2
- S ^TMP($J,LIST,PSSPO,"ADD",PSSA,.03)=X3
- S ^TMP($J,LIST,PSSPO,"ADD",0)=$G(^TMP($J,LIST,PSSPO,"ADD",0))+1
- G PSSA
- PSSS I ^TMP($J,LIST,PSSPO,"ADD",0)'>0 S ^TMP($J,LIST,PSSPO,"ADD",0)="-1^NO DATA FOUND"
- S PSSS=$O(^PS(55,DFN,"IV",PSSPO,"SOL",PSSS)) I PSSS'>0,$G(PSSLOOP)'=1 D G PSS436Q
- .I ^TMP($J,LIST,PSSPO,"SOL",0)=0 S ^TMP($J,LIST,PSSPO,"SOL",0)="-1^NO DATA FOUND"
- I PSSS'>0 D G LOOP436
- .I ^TMP($J,LIST,PSSPO,"SOL",0)=0 S ^TMP($J,LIST,PSSPO,"SOL",0)="-1^NO DATA FOUND"
- S PSSDATA=$G(^PS(55,DFN,"IV",PSSPO,"SOL",PSSS,0)),X1=$P(PSSDATA,"^"),X2=$P(PSSDATA,"^",2)
- S ^TMP($J,LIST,PSSPO,"SOL",PSSS,.01)=X1_"^"_$P($G(^PS(52.7,X1,0)),"^")
- S ^TMP($J,LIST,PSSPO,"SOL",PSSS,1)=X2
- S ^TMP($J,LIST,PSSPO,"SOL",0)=$G(^TMP($J,LIST,PSSPO,"SOL",0))+1
- G PSSS
- PSS436Q K ^UTILITY("DIQ1",$J),DIQ I '$D(^TMP($J,LIST,"B")) S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
- K PSSPO,PSSA,PSSDATA,X,LIST,X1,X2,PSSS,ORDER,PSSLOOP,DA,DR,DIC Q
- NODATA S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
- Q K IEN,PSSA,PSSS,PSSSTAT,X,LIST,X1,X2,X3,PSSDIY Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS55 7838 printed Jan 18, 2025@03:30:58 Page 2
- PSS55 ;BHM/DB/TSS - API FOR PHARMACY PATIENT FILE ;15 JUN 05
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**101,108,118,88,133**;9/30/97;Build 1
- +2 ;
- PSS431(DFN,PO,PSDATE,PEDATE,LIST) ;
- +1 GOTO ^PSS551
- PSS432(DFN,PO,LIST) ;SRS 3.2.43.2
- +1 NEW D0,DA,DR,DIC,IEN,PSSTMP,PSSTMP2
- +2 ;DFN: IEN of Patient [REQUIRED]
- +3 ;PO: Order # IEN [optional] If left blank, all active orders will be returned
- +4 ;LIST: Subscript name used in ^TMP global [REQUIRED]
- +5 NEW PSSPO,PSSDT,PSSIEN,PSSDATA,PSSQ
- +6 if $GET(LIST)=""
- QUIT
- KILL ^TMP($JOB,LIST)
- +7 IF +$GET(DFN)'>0
- GOTO NODATA
- +8 SET ^TMP($JOB,LIST,0)=0
- +9 IF '$DATA(^PS(55,DFN,0))
- GOTO NODATA
- +10 IF $GET(PO)'=""
- IF $DATA(^PS(55,DFN,5,PO))
- SET PSSPO=$PIECE(^PS(55,DFN,5,PO,0),"^")
- IF $GET(PSSPO)>0
- SET (DA(55.06),IEN)=PO
- GOTO AUS2
- +11 IF $GET(PO)'=""
- IF $GET(PSSPO)=""
- GOTO NODATA
- +12 SET PSSDT=0
- AUS ;Loop through stop date/time xref
- +1 FOR
- SET PSSDT=$ORDER(^PS(55,DFN,5,"AUS",PSSDT))
- if PSSDT'>0
- QUIT
- SET PSSIEN=0
- Begin DoDot:1
- +2 FOR
- SET PSSIEN=$ORDER(^PS(55,DFN,5,"AUS",PSSDT,PSSIEN))
- if PSSIEN'>0
- QUIT
- Begin DoDot:2
- +3 SET (IEN,DA(55.06))=PSSIEN
- SET PSSDATA=$GET(^PS(55,DFN,5,PSSIEN,0))
- IF $PIECE(PSSDATA,"^",9)'="A"
- QUIT
- +4 DO AUSDIQ
- End DoDot:2
- End DoDot:1
- +5 SET ^TMP($JOB,LIST,0)=$SELECT(^TMP($JOB,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($JOB,LIST,0))
- +6 KILL PSSIEN,PSSDT,PSSDATA,LIST
- +7 QUIT
- AUSDIQ KILL ^UTILITY("DIQ1",$JOB),DIQ
- +1 SET DA=DFN
- SET DIC=55
- SET DR=62
- SET DR(55.06)=".01;.5;1;3;4;5;6;7;9;11;12;26;27;27.1;28"
- SET DIQ(0)="IE"
- DO EN^DIQ1
- +2 SET PSSPO=$GET(^UTILITY("DIQ1",$JOB,55.06,IEN,.01,"E"))
- FOR X=.01,.5,1,3,4,5,6,7,9,11,12,26,27,27.1,28
- SET ^TMP($JOB,LIST,IEN,X)=$GET(^UTILITY("DIQ1",$JOB,55.06,IEN,X,"I"))
- +3 FOR X=.5,1,3,4,5,6,7,9,27,27.1,28
- SET ^TMP($JOB,LIST,IEN,X)=$SELECT($GET(^UTILITY("DIQ1",$JOB,55.06,IEN,X,"E"))'="":^TMP($JOB,LIST,IEN,X)_"^"_$GET(^UTILITY("DIQ1",$JOB,55.06,IEN,X,"E")),1:"")
- +4 SET PSSTMP=$PIECE($GET(^PS(55,DFN,5,IEN,.2)),U)
- SET ^TMP($JOB,LIST,IEN,108)=$SELECT($GET(PSSTMP)="":"",1:$$ORDITEM(+PSSTMP))
- +5 KILL ^UTILITY("DIQ1",$JOB),DIQ
- +6 SET ^TMP($JOB,LIST,"B",IEN)=""
- SET ^TMP($JOB,LIST,0)=$GET(^TMP($JOB,LIST,0))+1
- +7 QUIT
- ORDITEM(PSSTMP) ;
- +1 ;Reference to ^PSNDF(50.606 is supported by DBIA 2174
- +2 SET PSSTMP2=$GET(^PS(50.7,PSSTMP,0))
- +3 IF PSSTMP2'=""
- SET PSSTMP=PSSTMP_U_$PIECE($GET(PSSTMP2),U)_U_$PIECE($GET(PSSTMP2),U,2)_U_$PIECE($GET(^PS(50.606,$PIECE($GET(PSSTMP2),U,2),0)),U,1)
- +4 QUIT PSSTMP
- AUS2 ;one PO
- +1 SET PSSQ=1
- DO AUSDIQ
- +2 SET ^TMP($JOB,LIST,0)=$SELECT(^TMP($JOB,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($JOB,LIST,0))
- AUSQ KILL PSSDT,PSSIEN,PSSDATA,PSSPO,LIST,X,PSSQ,DA,DR,DIC
- QUIT
- +1 ;
- PSS433(DFN,LIST) ;
- +1 ;DFN: IEN of Patient [REQUIRED]
- +2 ;LIST: Subscript name used in ^TMP global [REQUIRED]
- +3 NEW X,DA,DR,PSSPO,PSSIEN,D0,IEN,PSSTMP,PSSTMP2
- +4 if $GET(LIST)=""
- QUIT
- KILL ^TMP($JOB,LIST)
- +5 IF $GET(DFN)'>0
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +6 IF '$DATA(^PS(55,DFN))
- GOTO NODATA
- +7 SET PSSIEN=0
- SET ^TMP($JOB,LIST,0)=0
- BGN433 SET PSSIEN=$ORDER(^PS(55,DFN,5,PSSIEN))
- if PSSIEN'>0
- GOTO Q433
- SET PSSPO=$PIECE($GET(^PS(55,DFN,5,PSSIEN,0)),"^")
- +1 SET (IEN,DA(55.06))=PSSIEN
- SET DIC=55
- SET DA=DFN
- SET DR=62
- SET DR(55.06)=".5;9;25;26;34;41;42;70"
- SET DIQ(0)="IE"
- DO EN^DIQ1
- +2 FOR X=.5,9,25,26,34,41,42,70
- SET ^TMP($JOB,LIST,+PSSIEN,X)=$GET(^UTILITY("DIQ1",$JOB,55.06,IEN,X,"I"))
- +3 SET PSSTMP=$PIECE($GET(^PS(55,DFN,5,PSSIEN,.2)),U)
- SET ^TMP($JOB,LIST,IEN,108)=$SELECT($GET(PSSTMP)="":"",1:$$ORDITEM(+PSSTMP))
- +4 FOR X=.5,9,25,34,70
- SET ^TMP($JOB,LIST,+PSSIEN,X)=$SELECT($GET(^UTILITY("DIQ1",$JOB,55.06,IEN,X,"E"))'="":^TMP($JOB,LIST,+PSSIEN,X)_"^"_$GET(^UTILITY("DIQ1",$JOB,55.06,IEN,X,"E")),1:"")
- +5 SET ^TMP($JOB,LIST,0)=$GET(^TMP($JOB,LIST,0))+1
- +6 SET ^TMP($JOB,LIST,"B",+PSSIEN)=""
- +7 GOTO BGN433
- Q433 KILL ^UTILITY("DIQ1",$JOB),PSSIEN,X,DR,DIC,DA,LIST
- QUIT
- PSS435(DFN,PO,LIST) ;SRS 3.2.43.5
- +1 NEW D0,DA,DIC,DR,IEN,X,PSSPO,PSSDATA,PSSIEN,PSSDT,PSSTMP,PSSTMP2,PSSSTAT
- +2 ;DFN: IEN of Patient [REQUIRED]
- +3 ;PO: Order # [optional] If left blank, all active orders will be returned.
- +4 ;LIST: Subscript name used in ^TMP global [REQUIRED]
- +5 ;Active hyperal orders utilizing "AIT" cross reference
- +6 if $GET(LIST)=""
- QUIT
- KILL ^TMP($JOB,LIST)
- +7 IF $GET(DFN)'>0
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +8 IF '$DATA(^PS(55,DFN,"IV","AIT","H"))
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +9 SET PSSDT=0
- SET ^TMP($JOB,LIST,0)=0
- AIT ;loop trough AIT xref
- +1 SET PSSDT=$ORDER(^PS(55,DFN,"IV","AIT","H",PSSDT))
- if PSSDT'>0
- GOTO AITQ
- SET PSSIEN=0
- AIT1 SET PSSIEN=$ORDER(^PS(55,DFN,"IV","AIT","H",PSSDT,PSSIEN))
- if PSSIEN'>0
- GOTO AIT
- +1 SET PSSDATA=$GET(^PS(55,DFN,"IV",PSSIEN,0))
- SET PSSSTAT=$PIECE($GET(PSSDATA),"^",17)
- IF PSSSTAT'="A"
- IF $GET(PO)'>0
- GOTO AIT1
- +2 IF +$GET(PO)>0
- if PSSIEN'=PO
- GOTO AIT1
- +3 SET PSSPO=$PIECE(PSSDATA,"^",1)
- SET ^TMP($JOB,LIST,"B",+PSSIEN)=""
- AITDIQ KILL ^UTILITY("DIQ1",$JOB)
- SET DA=DFN
- SET (IEN,DA(55.01))=PSSIEN
- SET DIC=55
- SET DR=100
- SET DIQ(0)="IE"
- SET DR(55.01)=".01;.02;.03;.04;.06;.08;.09;.12;.17;.24;9;31;100;104;106;108;110;112;120;121;132"
- DO EN^DIQ1
- +1 FOR X=.01,.02,.03,.04,.06,.08,.09,.12,.17,.24,9,31,100,104,106,108,110,112,120,121,132
- SET ^TMP($JOB,LIST,PSSPO,X)=$GET(^UTILITY("DIQ1",$JOB,55.01,IEN,X,"I"))
- +2 FOR X=.02,.03,.04,.06,9,100,106,108,112,120,121,132
- SET ^TMP($JOB,LIST,PSSPO,X)=$SELECT($GET(^UTILITY("DIQ1",$JOB,55.01,IEN,X,"E"))'="":^TMP($JOB,LIST,PSSPO,X)_"^"_$GET(^UTILITY("DIQ1",$JOB,55.01,IEN,X,"E")),1:"")
- +3 SET PSSTMP=$PIECE($GET(^PS(55,DFN,"IV",PSSIEN,.2)),U)
- SET ^TMP($JOB,LIST,IEN,130)=$SELECT($GET(PSSTMP)="":"",1:$$ORDITEM(+PSSTMP))
- +4 KILL ^UTILITY("DIQ1",$JOB)
- +5 SET ^TMP($JOB,LIST,0)=$GET(^TMP($JOB,LIST,0))+1
- +6 GOTO AIT1
- AITQ IF $GET(^TMP($JOB,LIST,0))=0
- KILL ^TMP($JOB,LIST)
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- +1 KILL PSSIEN,PSSDT,PSSSTAT,PSSDATA,PO,X,LIST
- QUIT
- +2 ;
- PSS436(DFN,ORDER,LIST) ;SRS 3.2.43.6
- +1 NEW D0,IEN,X,PSSTMP,PSSTMP2,DA,PSSLOOP,PSSPO,DIC,DR,PSSTMP,PSSA,PSSS,PSSDATA
- +2 ;DFN: IEN of Patient [REQUIRED]
- +3 ;ORDER: ORDER NUMBER [REQUIRED]
- +4 ;LIST: Subscript name used in ^TMP global [REQUIRED]
- +5 ;Active IV AD nodes
- +6 KILL PSSLOOP
- if $GET(LIST)=""
- QUIT
- KILL ^TMP($JOB,LIST)
- IF $GET(DFN)'>0
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +7 IF '$DATA(^PS(55,DFN))
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +8 KILL ^TMP($JOB,LIST)
- IF $GET(ORDER)=""
- SET PSSLOOP=1
- SET ORDER=0
- GOTO LOOP436
- +9 IF $GET(ORDER)'=""
- SET PSSPO=$ORDER(^PS(55,DFN,"IV","B",ORDER,0))
- if $GET(PSSPO)'>0
- GOTO PSS436Q
- GOTO DIQ436
- LOOP436 SET ORDER=$ORDER(^PS(55,DFN,"IV","B",ORDER))
- if ORDER'>0
- GOTO PSS436Q
- SET PSSPO=$ORDER(^PS(55,DFN,"IV","B",ORDER,0))
- DIQ436 KILL DA,DR
- SET DA=DFN
- SET (IEN,DA(55.01))=PSSPO
- SET DIC=55
- SET DR=100
- +1 SET DR(55.01)=".01;.02;.03;.04;.06;.08;.09;.12;.17;.24;9;31;100;104;106;108;110;112;120;121;132;147"
- +2 SET DIQ(0)="IE"
- DO EN^DIQ1
- IF '$DATA(^UTILITY("DIQ1",$JOB))
- GOTO NODATA
- +3 FOR X=.01,.02,.03,.04,.06,.08,.09,.12,.17,.24,9,31,100,104,106,108,110,112,120,121,132,147
- SET ^TMP($JOB,LIST,PSSPO,X)=$GET(^UTILITY("DIQ1",$JOB,55.01,IEN,X,"I"))
- +4 FOR X=.02,.03,.04,.06,9,100,106,108,112,120,121,132,147
- SET ^TMP($JOB,LIST,PSSPO,X)=$SELECT($GET(^UTILITY("DIQ1",$JOB,55.01,IEN,X,"E"))'="":^TMP($JOB,LIST,PSSPO,X)_"^"_$GET(^UTILITY("DIQ1",$JOB,55.01,IEN,X,"E")),1:"")
- +5 SET PSSTMP=$PIECE($GET(^PS(55,DFN,"IV",PSSPO,.2)),U)
- SET ^TMP($JOB,LIST,IEN,130)=$SELECT($GET(PSSTMP)="":"",1:$$ORDITEM(+PSSTMP))
- +6 SET ^TMP($JOB,LIST,"B",PSSPO)=""
- SET PSSA=0
- SET ^TMP($JOB,LIST,0)=$GET(^TMP($JOB,LIST,0))+1
- +7 SET ^TMP($JOB,LIST,PSSPO,"ADD",0)=0
- PSSA SET PSSA=$ORDER(^PS(55,DFN,"IV",PSSPO,"AD",PSSA))
- IF PSSA'>0
- SET PSSS=0
- SET ^TMP($JOB,LIST,PSSPO,"SOL",0)=0
- GOTO PSSS
- +1 SET PSSDATA=$GET(^PS(55,DFN,"IV",PSSPO,"AD",PSSA,0))
- SET X1=$PIECE(PSSDATA,"^")
- SET X2=$PIECE(PSSDATA,"^",2)
- SET X3=$PIECE(PSSDATA,"^",3)
- +2 SET ^TMP($JOB,LIST,PSSPO,"ADD",PSSA,.01)=X1_"^"_$PIECE($GET(^PS(52.6,X1,0)),"^")
- +3 SET ^TMP($JOB,LIST,PSSPO,"ADD",PSSA,.02)=X2
- +4 SET ^TMP($JOB,LIST,PSSPO,"ADD",PSSA,.03)=X3
- +5 SET ^TMP($JOB,LIST,PSSPO,"ADD",0)=$GET(^TMP($JOB,LIST,PSSPO,"ADD",0))+1
- +6 GOTO PSSA
- PSSS IF ^TMP($JOB,LIST,PSSPO,"ADD",0)'>0
- SET ^TMP($JOB,LIST,PSSPO,"ADD",0)="-1^NO DATA FOUND"
- +1 SET PSSS=$ORDER(^PS(55,DFN,"IV",PSSPO,"SOL",PSSS))
- IF PSSS'>0
- IF $GET(PSSLOOP)'=1
- Begin DoDot:1
- +2 IF ^TMP($JOB,LIST,PSSPO,"SOL",0)=0
- SET ^TMP($JOB,LIST,PSSPO,"SOL",0)="-1^NO DATA FOUND"
- End DoDot:1
- GOTO PSS436Q
- +3 IF PSSS'>0
- Begin DoDot:1
- +4 IF ^TMP($JOB,LIST,PSSPO,"SOL",0)=0
- SET ^TMP($JOB,LIST,PSSPO,"SOL",0)="-1^NO DATA FOUND"
- End DoDot:1
- GOTO LOOP436
- +5 SET PSSDATA=$GET(^PS(55,DFN,"IV",PSSPO,"SOL",PSSS,0))
- SET X1=$PIECE(PSSDATA,"^")
- SET X2=$PIECE(PSSDATA,"^",2)
- +6 SET ^TMP($JOB,LIST,PSSPO,"SOL",PSSS,.01)=X1_"^"_$PIECE($GET(^PS(52.7,X1,0)),"^")
- +7 SET ^TMP($JOB,LIST,PSSPO,"SOL",PSSS,1)=X2
- +8 SET ^TMP($JOB,LIST,PSSPO,"SOL",0)=$GET(^TMP($JOB,LIST,PSSPO,"SOL",0))+1
- +9 GOTO PSSS
- PSS436Q KILL ^UTILITY("DIQ1",$JOB),DIQ
- IF '$DATA(^TMP($JOB,LIST,"B"))
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- +1 KILL PSSPO,PSSA,PSSDATA,X,LIST,X1,X2,PSSS,ORDER,PSSLOOP,DA,DR,DIC
- QUIT
- NODATA SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- Q KILL IEN,PSSA,PSSS,PSSSTAT,X,LIST,X1,X2,X3,PSSDIY
- QUIT