RMPOLT ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
;;3.0;PROSTHETICS;**29**;Feb 09, 1996
EN ; -- main entry point for RMPO LETTER
;
; Input:
; RMPOLCD - Selected Home Oxygen Letter code
;
; Called by:
; RMPOLZ - H.O. Letter Control module
;
D EN^VALM("RMPO LETTER")
Q
;
HDR ; -- header code
S VALMHDR(1)=$$CNTR^RMPOLY(" ",$$EXTERNAL^DILFD(669.965,1,"",RMPOLCD),80)
S VALMHDR(2)=$$CNTR^RMPOLY(" ","HOME OXYGEN PATIENT LETTER LIST",80)
Q
;
INIT ; -- init variables and list array
N RMPODFN,REC,RMPOITEM,Y,X,SP
;
; for each entry in list for the selected letter type display details
S RMPONAM="",VALMCNT=0,$P(SP," ",80)=" "
F S RMPONAM=$O(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM="" D
. S RMPODFN=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
. S REC=^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN),VALMCNT=VALMCNT+1
. S Y=$P(REC,U,3) D DD^%DT S RMPORX=Y,Y=$P(REC,U,4)
. I Y'="" D DD^%DT
. I Y="" S Y="No Rx!"
. S RMPOEXP=Y,RMPOITEM=$P(REC,U,5)
. S:RMPOITEM="" RMPOITEM="No Primary!"
. ;
. S X=$$SETFLD^VALM1($E(VALMCNT_SP,1,$P(VALMDDF("LINE #"),U,3)),"","LINE #")
. S X=$$SETFLD^VALM1($P(REC,U),X,"PATIENT")
. S X=$$SETFLD^VALM1($P(REC,U,2),X,"SSN")
. S X=$$SETFLD^VALM1(RMPOITEM,X,"PRIMARY ITEM")
. S X=$$SETFLD^VALM1(RMPORX,X,"ACTIVATION DATE")
. S X=$$SETFLD^VALM1(RMPOEXP,X,"Rx EXPIRY DATE")
. D SET^VALM10(VALMCNT,X,RMPODFN)
;
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEAN^VALM10
;
Q
;
EXPND ; -- expand code
Q
;
EN02 ; Delete list entry
;
N SEL,LINE
;
; Select lines to delete
S SEL=$$SELN^RMPOLZA("L","Enter lines to delete",VALMCNT)
I SEL="^" S ^TMP($J,RMPOXITE,"EXIT")=1 Q ; quit to menu
Q:'SEL
;
N CNT
;
; for each patient selected remove 'Letter to be sent' from
; Prosthetics Patient File (665)
F CNT=1:1 S LINE=$P(SEL,",",CNT) Q:LINE="" D
. S RMPODFN=$O(@VALMAR@("IDX",LINE,""))
. D UPDLTR^RMPOLZA(RMPODFN,"@")
. ;
. ; purge work file holding data
. K ^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN)
;
; delete listman data and rebuild list from amended work file
D CLEAN^VALM10,INIT
Q:'$D(@VALMAR) ; Quit if there are no entries in list
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOLT 2326 printed Nov 22, 2024@17:41:06 Page 2
RMPOLT ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
+1 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
EN ; -- main entry point for RMPO LETTER
+1 ;
+2 ; Input:
+3 ; RMPOLCD - Selected Home Oxygen Letter code
+4 ;
+5 ; Called by:
+6 ; RMPOLZ - H.O. Letter Control module
+7 ;
+8 DO EN^VALM("RMPO LETTER")
+9 QUIT
+10 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$CNTR^RMPOLY(" ",$$EXTERNAL^DILFD(669.965,1,"",RMPOLCD),80)
+2 SET VALMHDR(2)=$$CNTR^RMPOLY(" ","HOME OXYGEN PATIENT LETTER LIST",80)
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 NEW RMPODFN,REC,RMPOITEM,Y,X,SP
+2 ;
+3 ; for each entry in list for the selected letter type display details
+4 SET RMPONAM=""
SET VALMCNT=0
SET $PIECE(SP," ",80)=" "
+5 FOR
SET RMPONAM=$ORDER(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM))
if RMPONAM=""
QUIT
Begin DoDot:1
+6 SET RMPODFN=$PIECE(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
+7 SET REC=^TMP($JOB,RMPOXITE,"RMPODEMO",RMPODFN)
SET VALMCNT=VALMCNT+1
+8 SET Y=$PIECE(REC,U,3)
DO DD^%DT
SET RMPORX=Y
SET Y=$PIECE(REC,U,4)
+9 IF Y'=""
DO DD^%DT
+10 IF Y=""
SET Y="No Rx!"
+11 SET RMPOEXP=Y
SET RMPOITEM=$PIECE(REC,U,5)
+12 if RMPOITEM=""
SET RMPOITEM="No Primary!"
+13 ;
+14 SET X=$$SETFLD^VALM1($EXTRACT(VALMCNT_SP,1,$PIECE(VALMDDF("LINE #"),U,3)),"","LINE #")
+15 SET X=$$SETFLD^VALM1($PIECE(REC,U),X,"PATIENT")
+16 SET X=$$SETFLD^VALM1($PIECE(REC,U,2),X,"SSN")
+17 SET X=$$SETFLD^VALM1(RMPOITEM,X,"PRIMARY ITEM")
+18 SET X=$$SETFLD^VALM1(RMPORX,X,"ACTIVATION DATE")
+19 SET X=$$SETFLD^VALM1(RMPOEXP,X,"Rx EXPIRY DATE")
+20 DO SET^VALM10(VALMCNT,X,RMPODFN)
End DoDot:1
+21 ;
+22 QUIT
+23 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CLEAN^VALM10
+2 ;
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
EN02 ; Delete list entry
+1 ;
+2 NEW SEL,LINE
+3 ;
+4 ; Select lines to delete
+5 SET SEL=$$SELN^RMPOLZA("L","Enter lines to delete",VALMCNT)
+6 ; quit to menu
IF SEL="^"
SET ^TMP($JOB,RMPOXITE,"EXIT")=1
QUIT
+7 if 'SEL
QUIT
+8 ;
+9 NEW CNT
+10 ;
+11 ; for each patient selected remove 'Letter to be sent' from
+12 ; Prosthetics Patient File (665)
+13 FOR CNT=1:1
SET LINE=$PIECE(SEL,",",CNT)
if LINE=""
QUIT
Begin DoDot:1
+14 SET RMPODFN=$ORDER(@VALMAR@("IDX",LINE,""))
+15 DO UPDLTR^RMPOLZA(RMPODFN,"@")
+16 ;
+17 ; purge work file holding data
+18 KILL ^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),^TMP($JOB,RMPOXITE,"RMPODEMO",RMPODFN)
End DoDot:1
+19 ;
+20 ; delete listman data and rebuild list from amended work file
+21 DO CLEAN^VALM10
DO INIT
+22 ; Quit if there are no entries in list
if '$DATA(@VALMAR)
QUIT
+23 SET VALMBCK="R"
+24 QUIT
