| 1 | RMPOLT ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
|
|---|
| 2 | ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
|
|---|
| 3 | EN ; -- main entry point for RMPO LETTER
|
|---|
| 4 | ;
|
|---|
| 5 | ; Input:
|
|---|
| 6 | ; RMPOLCD - Selected Home Oxygen Letter code
|
|---|
| 7 | ;
|
|---|
| 8 | ; Called by:
|
|---|
| 9 | ; RMPOLZ - H.O. Letter Control module
|
|---|
| 10 | ;
|
|---|
| 11 | D EN^VALM("RMPO LETTER")
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | HDR ; -- header code
|
|---|
| 15 | S VALMHDR(1)=$$CNTR^RMPOLY(" ",$$EXTERNAL^DILFD(669.965,1,"",RMPOLCD),80)
|
|---|
| 16 | S VALMHDR(2)=$$CNTR^RMPOLY(" ","HOME OXYGEN PATIENT LETTER LIST",80)
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | INIT ; -- init variables and list array
|
|---|
| 20 | N RMPODFN,REC,RMPOITEM,Y,X,SP
|
|---|
| 21 | ;
|
|---|
| 22 | ; for each entry in list for the selected letter type display details
|
|---|
| 23 | S RMPONAM="",VALMCNT=0,$P(SP," ",80)=" "
|
|---|
| 24 | F S RMPONAM=$O(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM="" D
|
|---|
| 25 | . S RMPODFN=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
|
|---|
| 26 | . S REC=^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN),VALMCNT=VALMCNT+1
|
|---|
| 27 | . S Y=$P(REC,U,3) D DD^%DT S RMPORX=Y,Y=$P(REC,U,4)
|
|---|
| 28 | . I Y'="" D DD^%DT
|
|---|
| 29 | . I Y="" S Y="No Rx!"
|
|---|
| 30 | . S RMPOEXP=Y,RMPOITEM=$P(REC,U,5)
|
|---|
| 31 | . S:RMPOITEM="" RMPOITEM="No Primary!"
|
|---|
| 32 | . ;
|
|---|
| 33 | . S X=$$SETFLD^VALM1($E(VALMCNT_SP,1,$P(VALMDDF("LINE #"),U,3)),"","LINE #")
|
|---|
| 34 | . S X=$$SETFLD^VALM1($P(REC,U),X,"PATIENT")
|
|---|
| 35 | . S X=$$SETFLD^VALM1($P(REC,U,2),X,"SSN")
|
|---|
| 36 | . S X=$$SETFLD^VALM1(RMPOITEM,X,"PRIMARY ITEM")
|
|---|
| 37 | . S X=$$SETFLD^VALM1(RMPORX,X,"ACTIVATION DATE")
|
|---|
| 38 | . S X=$$SETFLD^VALM1(RMPOEXP,X,"Rx EXPIRY DATE")
|
|---|
| 39 | . D SET^VALM10(VALMCNT,X,RMPODFN)
|
|---|
| 40 | ;
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | HELP ; -- help code
|
|---|
| 44 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | EXIT ; -- exit code
|
|---|
| 48 | D CLEAN^VALM10
|
|---|
| 49 | ;
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | EXPND ; -- expand code
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | EN02 ; Delete list entry
|
|---|
| 56 | ;
|
|---|
| 57 | N SEL,LINE
|
|---|
| 58 | ;
|
|---|
| 59 | ; Select lines to delete
|
|---|
| 60 | S SEL=$$SELN^RMPOLZA("L","Enter lines to delete",VALMCNT)
|
|---|
| 61 | I SEL="^" S ^TMP($J,RMPOXITE,"EXIT")=1 Q ; quit to menu
|
|---|
| 62 | Q:'SEL
|
|---|
| 63 | ;
|
|---|
| 64 | N CNT
|
|---|
| 65 | ;
|
|---|
| 66 | ; for each patient selected remove 'Letter to be sent' from
|
|---|
| 67 | ; Prosthetics Patient File (665)
|
|---|
| 68 | F CNT=1:1 S LINE=$P(SEL,",",CNT) Q:LINE="" D
|
|---|
| 69 | . S RMPODFN=$O(@VALMAR@("IDX",LINE,""))
|
|---|
| 70 | . D UPDLTR^RMPOLZA(RMPODFN,"@")
|
|---|
| 71 | . ;
|
|---|
| 72 | . ; purge work file holding data
|
|---|
| 73 | . K ^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN)
|
|---|
| 74 | ;
|
|---|
| 75 | ; delete listman data and rebuild list from amended work file
|
|---|
| 76 | D CLEAN^VALM10,INIT
|
|---|
| 77 | Q:'$D(@VALMAR) ; Quit if there are no entries in list
|
|---|
| 78 | S VALMBCK="R"
|
|---|
| 79 | Q
|
|---|
