- 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 Mar 13, 2025@21:38:43 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
