101 lines
2.9 KiB
Mathematica
101 lines
2.9 KiB
Mathematica
|
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
|