93 lines
4.8 KiB
Mathematica
93 lines
4.8 KiB
Mathematica
RAUTL19B ;HISC/SWM-Utility Routine ;10/29/97 09:29
|
|
;;5.0;Radiology/Nuclear Medicine;**10**;Mar 16, 1998
|
|
;
|
|
CKREQD(A) ;once a REQ'D fld is "Y", all higher status's same REQ'D fld must be "Y"
|
|
N E,J,I,P,N,RA1,RASTNAM,RAER1,RAFLG,RAFLDNM,S,ARE
|
|
; RAERR is used by RAUTL19 to signal one or more errors
|
|
S E=0,N=0
|
|
; E = order # of status progression
|
|
; I = ien of ^RA(72,)
|
|
; J = .1 or .5
|
|
; P = valid piece number from dd
|
|
; store .1 and .5 nodes for each given order # E
|
|
F S E=$O(^RA(72,"AA",A,E)) Q:E'>0 D
|
|
. S I=$O(^RA(72,"AA",A,E,0)) Q:'I S RA1(E,.1)=$S($G(^RA(72,I,.1))]"":^(.1),1:"")_"^/"_I,RA1(E,.5)=$S($G(^(.5))]"":^(.5),1:"")_"^/"_I
|
|
. Q
|
|
; if a req'd fld = 'Y', then all higher statuses' same req'd fld = 'Y'
|
|
; raflg: 1 = a Yes has has been found on a status level for a field
|
|
F J=.1,.5 S P=0 D
|
|
. F S P=$O(^DD(72,"GL",J,P)) Q:P'=+P S E="",RAFLG=0 D
|
|
.. F S E=$O(RA1(E)) Q:E'=+E D
|
|
... I RAFLG=0,$$UP^XLFSTR($P($P(RA1(E,J),"/"),U,P))="Y" S RAFLG=1 Q
|
|
... I RAFLG,$$UP^XLFSTR($P($P(RA1(E,J),"/"),U,P))'="Y" S RAER1(J,P,E)=$O(^DD(72,"GL",J,P,0)),N=N+1 ; set error to field number of file 72
|
|
... Q
|
|
.. Q
|
|
. Q
|
|
PRTREQD ;print any error messages on req'd flds
|
|
Q:'$O(RAER1(0))
|
|
I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
|
|
W !!,RADASH,"Checking fields that have 'REQUIRED' in their name",RADASH,!?11,"within : ",A
|
|
S RAERR=1,S=$S(N>1:"s",1:""),ARE=$S(N>1:"are",1:"is")
|
|
I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
|
|
W !!?5,"There ",ARE," ",N," error",S," found in REQUIRED fields. The error",S
|
|
I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
|
|
W !?5,ARE," due to 'Y' being answered at a lower status, and 'N' being"
|
|
I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
|
|
W !?5,"answered at a higher status for the following prompts"
|
|
I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
|
|
W !!?5,"PROMPT",?55,"STATUS",?75,"DATA",!,?5,"------",?55,"------",?75,"----"
|
|
F J=.1,.5 S P=0 D Q:RAOUT
|
|
. F S P=$O(RAER1(J,P)) Q:P'=+P D Q:RAOUT
|
|
.. I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
|
|
.. S RAFLDNM=$O(^DD(72,"GL",J,P,0)),RAFLDNM=$P(^DD(72,RAFLDNM,.1),U) S E=0 W !?5,"'",RAFLDNM,"'"
|
|
.. F S E=$O(RA1(E)) Q:E'=+E I $G(RA1(E,J))]"" S RASTNAM=$P(^RA(72,$P(RA1(E,J),"/",2),0),U) W ?50,"(",E,")",?55,$E(RASTNAM,1,20),?77,$P($P(RA1(E,J),"/"),U,P),!
|
|
.. Q
|
|
. Q
|
|
I 'RAOUT,$Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
|
|
W !!?5,"Once a data item is required, it should be required at all higher statuses."
|
|
Q
|
|
CKCOMP(A) ; check COMPLETE status' reqd field not asked at COMPLETE
|
|
; and field is asked at status where it's not reqd
|
|
N E,RA1,RA2,RA3,I,N,P
|
|
; RA2() stores not-required-but-aksed fields
|
|
; RA3() stores required-but-not-asked fields, COMPLETE status only
|
|
S E=0
|
|
CK2 S E=$O(^RA(72,"AA",A,E)) G:E'>0 CK9
|
|
S I=$O(^RA(72,"AA",A,E,0)) G:'I CK2
|
|
F N=.1,.2,.5,.6 S RA1(E,N)=$S($G(^RA(72,I,N))]"":^(N),1:"")
|
|
; .1 and .2 nodes
|
|
F P=1,2,4,5,6,13,14 D
|
|
. I $$UP^XLFSTR($P(RA1(E,.1),U,P))'="Y",$$UP^XLFSTR($P(RA1(E,.2),U,P))="Y" S RA2(E,.1,P)=I_U_$P(RA1(E,.1),U,P)_U_$P(RA1(E,.2),U,P) ; not req'd but asked
|
|
. I E=9,$$UP^XLFSTR($P(RA1(E,.1),U,P))="Y",$$UP^XLFSTR($P(RA1(E,.2),U,P))'="Y" S RA3(.1,P)=I_U_$P(RA1(E,.1),U,P)_U_$P(RA1(E,.2),U,P) ; req'd but not asked, COMPLETE status only
|
|
; .5 and .6 nodes
|
|
F P=1,3,4,5,8,9 D
|
|
. I $$UP^XLFSTR($P(RA1(E,.5),U,P))'="Y",$$UP^XLFSTR($P(RA1(E,.6),U,P))="Y" S RA2(E,.5,P)=I_U_$P(RA1(E,.5),U,P)_U_$P(RA1(E,.6),U,P) ; not req'd but asked
|
|
. I E=9,$$UP^XLFSTR($P(RA1(E,.5),U,P))="Y",$$UP^XLFSTR($P(RA1(E,.6),U,P))'="Y" S RA3(.5,P)=I_U_$P(RA1(E,.5),U,P)_U_$P(RA1(E,.6),U,P) ; req'd but not asked, COMPLETE status only
|
|
G CK2
|
|
CK9 Q:'$D(RA2) ; there's no NOT-REQUIRED-BUT-ASKED FIELD(S) AT ANY STATUS
|
|
Q:'$D(RA3) ; there's no REQ'D-BUT-NOT-ASKED FIELDS AT COMPLETE
|
|
W !!,RADASH,"Warning on reaching Complete",RADASH,!?11,"within : ",A,!
|
|
W !?5,"The following are permissible, but could lead to failure to"
|
|
W !?5,"complete cases when prompts are not answered in lower status(es)."
|
|
W !!?5,"STATUS",?20,"PROMPT",?70,"DATA",!?5,"------",?20,"------",?70,"------"
|
|
G:'$D(RA2) CKWR7 S E=0
|
|
CKWR1 S E=$O(RA2(E)) G:'E CKWR7 S I=0
|
|
CKWR2 S I=$O(RA2(E,I)) G:'I CKWR1 S P=0
|
|
CKWR3 S P=$O(RA2(E,I,P)) G:'P CKWR2
|
|
G:'$D(RA3(I,P)) CKWR3 ; skip if there's no problem with COMPLETE's
|
|
S N=$O(^DD(72,"GL",I+.1,P,0)),N=$P(^DD(72,N,0),U)
|
|
I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
|
|
W !?5,$P(^RA(72,+RA2(E,I,P),0),U),?20,N,?70,$P(RA2(E,I,P),U,3)
|
|
S N=$O(^DD(72,"GL",I,P,0)),N=$P(^DD(72,N,0),U)
|
|
W !?20,N,?70,$P(RA2(E,I,P),U,2),!
|
|
G CKWR3
|
|
CKWR7 Q:'$D(RA3) S I=0
|
|
CKWR8 S I=$O(RA3(I)) Q:'I S P=0
|
|
CKWR9 S P=$O(RA3(I,P)) G:'P CKWR8
|
|
S N=$O(^DD(72,"GL",I+.1,P,0)),N=$P(^DD(72,N,0),U)
|
|
I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
|
|
W !?5,$P(^RA(72,+RA3(I,P),0),U),?20,N,?70,$P(RA3(I,P),U,3)
|
|
S N=$O(^DD(72,"GL",I,P,0)),N=$P(^DD(72,N,0),U)
|
|
W !?20,N,?70,$P(RA3(I,P),U,2),!
|
|
G CKWR9
|