- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOLY 3092 printed Feb 18, 2025@23:57:35 Page 2
- RMPOLY ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
- +1 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
- +2 ;
- EN ; -- main entry point for RMPO LETTER TYPE
- +1 ;
- +2 ; Input: None
- +3 ;
- +4 ; Output:
- +5 ; RMPOLCD - H.O. Letter Type code
- +6 ;
- +7 ; Called by:
- +8 ; RMPOLZ - H.O. Letter Control module
- +9 ;
- +10 NEW LSTN
- +11 ;
- +12 DO EN^VALM("RMPO LETTER TYPE")
- +13 QUIT
- +14 ;
- HDR ; -- header code
- +1 ;
- +2 SET VALMHDR(1)=$$CNTR(" ",RMPO("NAME"),80)
- +3 SET VALMHDR(2)=$$CNTR(" ","HOME OXYGEN PATIENT LETTER TYPE LIST",80)
- +4 QUIT
- +5 ;
- INIT ; -- init variables and list array
- +1 NEW SP,RMPOLCD,CNT,X,RMPOLTR,LTR
- +2 ;
- +3 SET $PIECE(SP," ",80)=" "
- +4 ;
- +5 ; initialise list
- +6 SET (PATV,VALMCNT,RMPOLCD,CNT)=0
- +7 ; for each valid H.O. letter type code define a line
- +8 FOR
- SET RMPOLCD=$ORDER(LTRX("A",RMPOLCD))
- if RMPOLCD=""
- QUIT
- Begin DoDot:1
- +9 SET VALMCNT=VALMCNT+1
- SET LSTN(VALMCNT)=RMPOLCD
- +10 SET CNT=0
- SET RMPONAM=""
- +11 FOR
- SET RMPONAM=$ORDER(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM))
- if RMPONAM=""
- QUIT
- Begin DoDot:2
- +12 SET CNT=CNT+1
- +13 SET RMPOLTR=$PIECE(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1)
- SET RMPODFN=$PIECE(^(RMPONAM),U,2)
- +14 SET LTR=$PIECE(^RMPR(665.2,RMPOLTR,0),U)
- +15 ; update "letter to be sent" flag for patient
- DO UPDLTR^RMPOLET0(RMPODFN,LTR)
- End DoDot:2
- +16 ;
- +17 SET X=$$SETFLD^VALM1($EXTRACT(VALMCNT_SP,1,$PIECE(VALMDDF("LINE #"),U,3)),"","LINE #")
- +18 SET X=$$SETFLD^VALM1($$EXTERNAL^DILFD(669.965,1,"",RMPOLCD),X,"DESCRIPTION")
- +19 SET X=$$SETFLD^VALM1(CNT,X,"PATIENT COUNT")
- +20 ; create list line
- DO SET^VALM10(VALMCNT,X,CNT)
- +21 ; at least one line have a patient count value > 0
- if CNT
- SET PATV=1
- End DoDot:1
- +22 ;
- +23 QUIT
- +24 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 DO CLEAN^VALM10
- +2 KILL LSTN,PATV
- +3 ;
- +4 QUIT
- +5 ;
- EXPND ; -- expand code
- +1 QUIT
- +2 ;
- EN01 ; Select letter type
- +1 NEW Y
- +2 SET VALMBCK="R"
- SET LST=0
- +3 ;I 'PATV S VALMSG="There are no patients awaiting a letter" Q
- +4 SET Y=$$SELN^RMPOLZA("N","Select letter type line #",VALMCNT)
- if 'Y
- QUIT
- +5 IF $GET(^TMP($JOB,RMPOXITE,"EXIT"))=1
- SET QT=1
- QUIT
- +6 SET VALMBCK="Q"
- +7 SET (RMPOLCD,RMC)=LSTN(Y)
- +8 SET RMBAT=$SELECT(RMC="A":"RMPOXBAT1",RMC="B":"RMPOXBAT2",RMC="C":"RMPOXBAT3",1:"")
- +9 SET RMBATCO=$SELECT(RMC="A":"^669.9002P^^",RMC="B":"^669.972P^^",RMC="C":"^669.974P^^^",1:"")
- +10 ;K ^RMPR(669.9,RMPOXITE,RMBAT) S ^RMPR(669.9,RMPOXITE,RMBAT,0)=RMBATCO
- +11 DO NEWLST^RMPOLZ
- +12 IF $ORDER(^RMPR(669.9,RMPOXITE,RMBAT,0))'>0
- SET VALMSG="No patients are awaiting letters of this type!!"
- HANG 4
- WRITE !,VALMSG
- QUIT
- +13 WRITE !,"DONE GENERATING A NEW LIST..."
- HANG 4
- +14 ; rebuild letter type list.
- +15 DO CLEAN^VALM10
- DO INIT^RMPOLY
- SET VALMBCK="R"
- SET RMPOLCD=""
- +16 QUIT
- +17 ;
- EN02 ; Print letters
- +1 ; select letter type. Quit if none choosen
- +2 ;D EN01^RMPOLY S VALMBCK="R" Q:RMPOLCD=""
- +3 NEW Y
- +4 SET VALMBCK="R"
- +5 IF 'PATV
- SET VALMSG="There are no patients awaiting a letter"
- QUIT
- +6 ;
- +7 SET Y=$$SELN^RMPOLZA("N","Select letter type line #",VALMCNT)
- if 'Y
- QUIT
- +8 WRITE !,$CHAR(7),"Processing...."
- +9 IF '$ORDER(@VALMAR@("IDX",Y,""))
- SET VALMSG="No patients are awaiting letters of this type!!"
- HANG 4
- WRITE !,VALMSG
- QUIT
- +10 SET VALMBCK="Q"
- SET RMPOLCD=LSTN(Y)
- +11 ;ask for patient to print
- +12 DO EN^RMPOLT
- +13 ; rebuild letter type list.
- +14 DO CLEAN^VALM10
- DO INIT^RMPOLY
- SET VALMBCK="R"
- SET RMPOLCD=""
- +15 QUIT
- +16 ;
- CNTR(PD,TXT,WDT) ; Centre text
- +1 SET $PIECE(PD,PD,WDT)=PD
- +2 QUIT $EXTRACT(PD,1,(WDT-$LENGTH(TXT))/2)_TXT