- 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 Feb 18, 2025@23:57:35 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