source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOLY.m@ 1312

RMPOLY ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
 ;
EN ; -- main entry point for RMPO LETTER TYPE
 ;
 ; Input: None
 ;
 ; Output:
 ;   RMPOLCD              -  H.O. Letter Type code
 ;
 ; Called by:
 ;   RMPOLZ               - H.O. Letter Control module
 ;
 N LSTN
 ;
 D EN^VALM("RMPO LETTER TYPE")
 Q
 ;
HDR ; -- header code
 ;
 S VALMHDR(1)=$$CNTR(" ",RMPO("NAME"),80)
 S VALMHDR(2)=$$CNTR(" ","HOME OXYGEN PATIENT LETTER TYPE LIST",80)
 Q
 ;
INIT ; -- init variables and list array
 N SP,RMPOLCD,CNT,X,RMPOLTR,LTR
 ;
 S $P(SP," ",80)=" "
 ;
 ; initialise list
 S (PATV,VALMCNT,RMPOLCD,CNT)=0
 ; for each valid H.O. letter type code define a line
 F  S RMPOLCD=$O(LTRX("A",RMPOLCD)) Q:RMPOLCD=""  D
 . S VALMCNT=VALMCNT+1,LSTN(VALMCNT)=RMPOLCD
 . S CNT=0,RMPONAM=""
 . F  S RMPONAM=$O(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM=""  D
 . . S CNT=CNT+1
 . . S RMPOLTR=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1),RMPODFN=$P(^(RMPONAM),U,2)
 . . S LTR=$P(^RMPR(665.2,RMPOLTR,0),U)
 . . D UPDLTR^RMPOLET0(RMPODFN,LTR)  ; update "letter to be sent" flag for patient
 . ;
 . S X=$$SETFLD^VALM1($E(VALMCNT_SP,1,$P(VALMDDF("LINE #"),U,3)),"","LINE #")
 . S X=$$SETFLD^VALM1($$EXTERNAL^DILFD(669.965,1,"",RMPOLCD),X,"DESCRIPTION")
 . S X=$$SETFLD^VALM1(CNT,X,"PATIENT COUNT")
 . D SET^VALM10(VALMCNT,X,CNT)  ; create list line
 . S:CNT PATV=1  ; at least one line have a patient count value > 0
 ;
 Q
 ;
HELP ; -- help code
 S X="?" D DISP^XQORM1 W !!
 Q
 ;
EXIT ; -- exit code
 D CLEAN^VALM10
 K LSTN,PATV
 ;
 Q
 ;
EXPND ; -- expand code
 Q
 ;
EN01 ; Select letter type
 N Y
 S VALMBCK="R",LST=0
 ;I 'PATV S VALMSG="There are no patients awaiting a letter" Q
 S Y=$$SELN^RMPOLZA("N","Select letter type line #",VALMCNT) Q:'Y
 I $G(^TMP($J,RMPOXITE,"EXIT"))=1 S QT=1 Q
 S VALMBCK="Q"
 S (RMPOLCD,RMC)=LSTN(Y)
 S RMBAT=$S(RMC="A":"RMPOXBAT1",RMC="B":"RMPOXBAT2",RMC="C":"RMPOXBAT3",1:"")
 S RMBATCO=$S(RMC="A":"^669.9002P^^",RMC="B":"^669.972P^^",RMC="C":"^669.974P^^^",1:"")
 ;K ^RMPR(669.9,RMPOXITE,RMBAT) S ^RMPR(669.9,RMPOXITE,RMBAT,0)=RMBATCO 
 D NEWLST^RMPOLZ
 I $O(^RMPR(669.9,RMPOXITE,RMBAT,0))'>0 S VALMSG="No patients are awaiting letters of this type!!" H 4 W !,VALMSG Q
 W !,"DONE GENERATING A NEW LIST..." H 4
 ; rebuild letter type list.
 D CLEAN^VALM10,INIT^RMPOLY S VALMBCK="R",RMPOLCD=""
 Q
 ;
EN02 ; Print letters
 ; select letter type. Quit if none choosen
 ;D EN01^RMPOLY S VALMBCK="R" Q:RMPOLCD=""
 N Y
 S VALMBCK="R"
 I 'PATV S VALMSG="There are no patients awaiting a letter" Q
 ;
 S Y=$$SELN^RMPOLZA("N","Select letter type line #",VALMCNT) Q:'Y
 W !,$C(7),"Processing...."
 I '$O(@VALMAR@("IDX",Y,"")) S VALMSG="No patients are awaiting letters of this type!!" H 4 W !,VALMSG Q
 S VALMBCK="Q",RMPOLCD=LSTN(Y)
 ;ask for patient to print
 D EN^RMPOLT
 ; rebuild letter type list.
 D CLEAN^VALM10,INIT^RMPOLY S VALMBCK="R",RMPOLCD=""
 Q
 ;
CNTR(PD,TXT,WDT) ; Centre text
 S $P(PD,PD,WDT)=PD
 Q $E(PD,1,(WDT-$L(TXT))/2)_TXT