ORQQPP ;SLC/CLA - Functions which return patient postings ;Jun 14, 2019@10:19
;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
LIST(ORY,ORPT) ;return pt's patient posting list
Q:'$L($G(ORPT))
N I,J,X,FMDT,MSG
K ^TMP("TIUPPCV",$J)
D ENCOVER^TIUPP3(ORPT)
I +MSG'=0 S ORY(1)="^No patient postings found."
S I=0,J=1,X=""
F S I=$O(^TMP("TIUPPCV",$J,I)) Q:I<1 D
.S X=^TMP("TIUPPCV",$J,I),ORY(J)=$P(X,U)_U_$P(X,U,3)_U_$P(X,U,5),J=J+1
K ^TMP("TIUPPCV",$J)
D POSTLIST^WVRPCOR(.ORY,ORPT,.J)
Q
PPIMM(ORY,ORPT) ;return pt's patient postings and immunizations
Q:'$L($G(ORPT))
N IMM,IVDT,IEN,X,ORJ
D LIST(.ORY,ORPT)
S ORJ=$O(ORY("?"),-1)+1
I $L($T(IMMUN^PXRHS03))<1 S ORY(ORJ)=";I^Immunizations not available." Q
K ^TMP("PXI",$J)
D IMMUN^PXRHS03(ORPT)
S IMM="",IVDT="",IEN=0
F S IMM=$O(^TMP("PXI",$J,IMM)) Q:IMM="" D
.F S IVDT=$O(^TMP("PXI",$J,IMM,IVDT)) Q:IVDT="" D
..F S IEN=$O(^TMP("PXI",$J,IMM,IVDT,IEN)) Q:IEN<1 D
...S X=$G(^TMP("PXI",$J,IMM,IVDT,IEN,0)) Q:'$L(X)
...S ORY(ORJ)=IEN_";I"_U_IMM_U_$P(X,U,3),ORJ=ORJ+1
S:'$L($G(ORY(ORJ))) ORY(ORJ)=";I^No immunizations found.^2900101"
K ^TMP("PXI",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQQPP 1176 printed Nov 22, 2024@17:43:41 Page 2
ORQQPP ;SLC/CLA - Functions which return patient postings ;Jun 14, 2019@10:19
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
LIST(ORY,ORPT) ;return pt's patient posting list
+1 if '$LENGTH($GET(ORPT))
QUIT
+2 NEW I,J,X,FMDT,MSG
+3 KILL ^TMP("TIUPPCV",$JOB)
+4 DO ENCOVER^TIUPP3(ORPT)
+5 IF +MSG'=0
SET ORY(1)="^No patient postings found."
+6 SET I=0
SET J=1
SET X=""
+7 FOR
SET I=$ORDER(^TMP("TIUPPCV",$JOB,I))
if I<1
QUIT
Begin DoDot:1
+8 SET X=^TMP("TIUPPCV",$JOB,I)
SET ORY(J)=$PIECE(X,U)_U_$PIECE(X,U,3)_U_$PIECE(X,U,5)
SET J=J+1
End DoDot:1
+9 KILL ^TMP("TIUPPCV",$JOB)
+10 DO POSTLIST^WVRPCOR(.ORY,ORPT,.J)
+11 QUIT
PPIMM(ORY,ORPT) ;return pt's patient postings and immunizations
+1 if '$LENGTH($GET(ORPT))
QUIT
+2 NEW IMM,IVDT,IEN,X,ORJ
+3 DO LIST(.ORY,ORPT)
+4 SET ORJ=$ORDER(ORY("?"),-1)+1
+5 IF $LENGTH($TEXT(IMMUN^PXRHS03))<1
SET ORY(ORJ)=";I^Immunizations not available."
QUIT
+6 KILL ^TMP("PXI",$JOB)
+7 DO IMMUN^PXRHS03(ORPT)
+8 SET IMM=""
SET IVDT=""
SET IEN=0
+9 FOR
SET IMM=$ORDER(^TMP("PXI",$JOB,IMM))
if IMM=""
QUIT
Begin DoDot:1
+10 FOR
SET IVDT=$ORDER(^TMP("PXI",$JOB,IMM,IVDT))
if IVDT=""
QUIT
Begin DoDot:2
+11 FOR
SET IEN=$ORDER(^TMP("PXI",$JOB,IMM,IVDT,IEN))
if IEN<1
QUIT
Begin DoDot:3
+12 SET X=$GET(^TMP("PXI",$JOB,IMM,IVDT,IEN,0))
if '$LENGTH(X)
QUIT
+13 SET ORY(ORJ)=IEN_";I"_U_IMM_U_$PIECE(X,U,3)
SET ORJ=ORJ+1
End DoDot:3
End DoDot:2
End DoDot:1
+14 if '$LENGTH($GET(ORY(ORJ)))
SET ORY(ORJ)=";I^No immunizations found.^2900101"
+15 KILL ^TMP("PXI",$JOB)
+16 QUIT
