Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPOLT

RMPOLT.m

Go to the documentation of this file.
  1. RMPOLT ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
  1. ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
  1. EN ; -- main entry point for RMPO LETTER
  1. ;
  1. ; Input:
  1. ; RMPOLCD - Selected Home Oxygen Letter code
  1. ;
  1. ; Called by:
  1. ; RMPOLZ - H.O. Letter Control module
  1. ;
  1. D EN^VALM("RMPO LETTER")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)=$$CNTR^RMPOLY(" ",$$EXTERNAL^DILFD(669.965,1,"",RMPOLCD),80)
  1. S VALMHDR(2)=$$CNTR^RMPOLY(" ","HOME OXYGEN PATIENT LETTER LIST",80)
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. N RMPODFN,REC,RMPOITEM,Y,X,SP
  1. ;
  1. ; for each entry in list for the selected letter type display details
  1. S RMPONAM="",VALMCNT=0,$P(SP," ",80)=" "
  1. F S RMPONAM=$O(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM="" D
  1. . S RMPODFN=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
  1. . S REC=^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN),VALMCNT=VALMCNT+1
  1. . S Y=$P(REC,U,3) D DD^%DT S RMPORX=Y,Y=$P(REC,U,4)
  1. . I Y'="" D DD^%DT
  1. . I Y="" S Y="No Rx!"
  1. . S RMPOEXP=Y,RMPOITEM=$P(REC,U,5)
  1. . S:RMPOITEM="" RMPOITEM="No Primary!"
  1. . ;
  1. . S X=$$SETFLD^VALM1($E(VALMCNT_SP,1,$P(VALMDDF("LINE #"),U,3)),"","LINE #")
  1. . S X=$$SETFLD^VALM1($P(REC,U),X,"PATIENT")
  1. . S X=$$SETFLD^VALM1($P(REC,U,2),X,"SSN")
  1. . S X=$$SETFLD^VALM1(RMPOITEM,X,"PRIMARY ITEM")
  1. . S X=$$SETFLD^VALM1(RMPORX,X,"ACTIVATION DATE")
  1. . S X=$$SETFLD^VALM1(RMPOEXP,X,"Rx EXPIRY DATE")
  1. . D SET^VALM10(VALMCNT,X,RMPODFN)
  1. ;
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D CLEAN^VALM10
  1. ;
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. EN02 ; Delete list entry
  1. ;
  1. N SEL,LINE
  1. ;
  1. ; Select lines to delete
  1. S SEL=$$SELN^RMPOLZA("L","Enter lines to delete",VALMCNT)
  1. I SEL="^" S ^TMP($J,RMPOXITE,"EXIT")=1 Q ; quit to menu
  1. Q:'SEL
  1. ;
  1. N CNT
  1. ;
  1. ; for each patient selected remove 'Letter to be sent' from
  1. ; Prosthetics Patient File (665)
  1. F CNT=1:1 S LINE=$P(SEL,",",CNT) Q:LINE="" D
  1. . S RMPODFN=$O(@VALMAR@("IDX",LINE,""))
  1. . D UPDLTR^RMPOLZA(RMPODFN,"@")
  1. . ;
  1. . ; purge work file holding data
  1. . K ^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN)
  1. ;
  1. ; delete listman data and rebuild list from amended work file
  1. D CLEAN^VALM10,INIT
  1. Q:'$D(@VALMAR) ; Quit if there are no entries in list
  1. S VALMBCK="R"
  1. Q