source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAMAIN1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.2 KB
Line 
1RAMAIN1 ;HISC/CAH,GJC-Radiology Utility File Maintenance ;10/29/97 13:30
2 ;;5.0;Radiology/Nuclear Medicine;**15,21**;Mar 16, 1998
3 ; This routine is a 'helper' routine for 'RAMAIN'.
4DSPLNKS ; This subroutine display the links between the wasted/unwasted
5 ; film size types. This subroutine is called from '4^RAMAIN'.
6 ; This subroutine is only accessed if the '^RA(78.4,"AW")' xref
7 ; exists.
8 N RA,RAFS,RAOUT,X,Y,Z S RAOUT=0
9 S X=0 F S X=$O(^RA(78.4,"AW",1,X)) Q:X'>0 D
10 . S RA(0)=$G(^RA(78.4,+X,0)) Q:RA(0)']""
11 . S RA(1)=$P(RA(0),U),RA(5)=+$P(RA(0),U,5)
12 . S RA(11)=$P($G(^RA(78.4,RA(5),0)),U)
13 . I RA(1)]"",(RA(11)]"") D
14 .. S RAFS("LW",RA(1))=RA(11),RAFS("LU",RA(11))=RA(1)
15 .. Q
16 . E D
17 .. S:RA(11)']"" RAFS("UW",RA(1))=""
18 .. Q
19 . Q
20 S X="" F S X=$O(^RA(78.4,"B",X)) Q:X']"" D
21 . I '$D(RAFS("LU",X))&('$D(RAFS("LW",X)))&('$D(RAFS("UW",X))) D
22 .. S RAFS("UU",X)=""
23 .. Q
24 . Q
25 I $D(RAFS("LU"))!($D(RAFS("UU")))!($D(RAFS("UW"))) D
26 . N X,Y,Y1,Z
27 . S X(1)="'Unwasted Film Size'",X(2)="'Corresponding Wasted Film Size'"
28 . S X(0)="Relationship between "_X(1)_" and "_X(2)_":"
29 . S $P(Y1,"-",($L(X(0))+1))="" D HDR(.X,Y1) ; Print out the list
30 . F Z(0)="LU","UU","UW" D Q:RAOUT
31 .. S Z="" F S Z=$O(RAFS(Z(0),Z)) Q:Z']""!(RAOUT) D
32 ... I Z(0)="LU" D
33 .... W !?5,Z
34 .... W ?40,$S($G(RAFS(Z(0),Z))]"":$G(RAFS(Z(0),Z)),1:"Error, missing data")
35 .... Q
36 ... I Z(0)="UU" D
37 .... W !?5,Z
38 .... W ?40,"unassociated with a 'Wasted Film' type"
39 .... Q
40 ... I Z(0)="UW" D
41 .... W !?5,"*** Error, missing Data ***"
42 .... W ?40,Z
43 .... Q
44 ... D:$Y>(IOSL-4) HDH
45 ... Q
46 .. Q
47 . Q
48 I $G(RAOUT)=0 D:($Y>5) HDH
49 Q
50HDH ; EOS prompt
51 S DIR(0)="E" D ^DIR K DIR,DIRUT,DIROUT,DTOUT,DUOUT
52 S:'+Y RAOUT=1 Q:RAOUT D:$D(X)\10&($D(Y1)) HDR(.X,Y1)
53 Q
54HDR(X,Y1) ; Header
55 W @IOF,!?(IOM-$L($G(X(0)))\2),$G(X(0)),!
56 W !?5,$G(X(1)),?40,$G(X(2)),!?(IOM-$L(Y1)\2),Y1,!
57 Q
581 ; Set-up/Edit the Examination Status file (72).
59 N RADATE,RAHDR,RALINE,RANOERR,RAOUT,RAPG
60 S RADATE=$$FMTE^XLFDT($$DT^XLFDT(),"")
61 S RAHDR="Data Inconsistency Report For Exam Statuses"
62 S RANOERR="Exam Status Data Inconsistencies Not Found."
63 S $P(RALINE,"=",(IOM+1))="",(RAOUT,RAPG)=0
64 N RAIMGTYI,RAIMGTYJ,RAORDXST S RAORDXST=0
65 S DIC="^RA(79.2,",DIC(0)="QEAMNZ",DIC("A")="Select an Imaging Type: "
66 D ^DIC K DIC G:+Y'>0 Q1
67 ; RAIMGTYI=ien of 79.2, RAIMGTYJ=xternal format of the .01
68 S RAOUT=0,RAIMGTYI=+Y,RAIMGTYJ=$P(Y,U,2)
69 F D Q:RAOUT
70 . K DINUM,DLAYGO,DO W !
71 . S DIC="^RA(72,",DIC(0)="QEALZ",DLAYGO=72
72 . S DIC("A")="Select an Examination Status: ",DIC("DR")="7////"_RAIMGTYI
73 . S DIC("S")="I +$P(^(0),U,7)=RAIMGTYI"
74 . S RADICW(1)="N RA S RA(0)=^(0),RA(3)=$P(RA(0),U,3) "
75 . S RADICW(2)="W ?35,""Imaging Type: "",?49,RAIMGTYJ"
76 . S RADICW(3)=",!?35,""Order: "",?42,RA(3)"
77 . S DIC("W")=RADICW(1)_RADICW(2)_RADICW(3)
78 . D ^DIC K DIC,DLAYGO,RADICW
79 . I +Y'>0 S RAOUT=1 Q
80 . W:$P(Y(0),U,3)=1 !!?5,"* Reminder * ",$P(Y,U,2)," does NOT need data entered for",!?7,"the 'ASK' and 'REQUIRED' fields. Registration automatically",!?7,"sets cases to this status since its ORDER number is 1.",!
81 . S (DA,RAXSTIEN)=+Y,DIE="^RA(72,",DR="[RA STATUS ENTRY]" D ^DIE
82 . I $D(DA) S RAEDT72=$G(^RA(72,DA,0)) I $P(RAEDT72,"^",3)="",$$UP^XLFSTR($P(RAEDT72,"^",5))="Y" D
83 .. W !!,"`"_$P(RAEDT72,"^")_"' is inactive, but appears on Status Tracking.",!,"This is appropriate if you need to use Status Tracking to process cases in"
84 .. W !,"this status to complete. However, if you have a large number of historic",!,"cases in this status, it will cause response time problems in Status Tracking."
85 .. Q
86 . K %,%X,%Y,C,D0,DA,DE,DI,DIE,DQ,DR,RAEDT72,RAEXST,X,Y
87 . Q
88 K %,DTOUT,DUOUT,RAOUT,RAXSTIEN,X,Y
89 N RADASH S $P(RADASH,"_",10)="",RADASH=" "_RADASH_" "
90 W @IOF
91 D XAMORD
92 S RAOUT=$$EOS^RAUTL5() Q:RAOUT
93 D PRELIM^RAUTL19(RAIMGTYJ) ; check data consistency
94Q1 K C,D,DDH,DUOUT,I,POP,RAXSTIEN
95 Q
96XAMORD ; check order number inconsistency for order # 0,1,9
97 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
98 W !!?$L(RADASH),"Checking order numbers",!,RADASH,"and Default Next Status used for status progression",RADASH,!?11,"within : ",RAIMGTYJ
99 S:'$D(RAOUT)#2 RAOUT=0
100 N I,J,RA0,RA2,RAORDXNM F I=0,1,9 D Q:RAOUT
101 . Q:($D(^RA(72,"AA",RAIMGTYJ,I))\10)
102 . N RASTAT S RAORDXST=1
103 . S RASTAT=$S(I=0:"Cancelled",I=1:"Waiting For Exam",1:"Complete")
104 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
105 . W !!?5,"Error: A status with order number '"_I_"' to represent"
106 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
107 . W !?5,"'"_RASTAT_"' is MISSING for this imaging type.",$C(7)
108 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
109 ; check that the DEFAULT NEXT STATUS has an ORDER no.
110 S I=0
111 F S I=$O(^RA(72,"AA",RAIMGTYJ,I)) Q:'I S J=$O(^(I,0)) I +J S RA0=^RA(72,J,0) D ;should always have subscript 5 ?
112 . Q:$P(RA0,U,3)=9 ;skip check if COMPLETE status
113 . S RA2=$G(^RA(72,+$P(RA0,U,2),0))
114 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
115 . I RA2="" W !!?5,$P(RA0,U),"'s Default Next Status (",$P(RA2,U),")'s record is missing" S RAORDXST=1 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
116 . I $P(RA2,U,3)="" W !!?5,$P(RA0,U),"'s Default Next Status (",$P(RA2,U),") is missing an ORDER no." S RAORDXST=1 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
117 .Q
118 W:'RAORDXST !!?5,"Required order numbers are in place."
119 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
120 W !
121 ; check that exam status 'COMPLETE','WAITING FOR EXAM' and
122 ; 'CANCELLED' exist
123 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
124 W !!,RADASH_"Checking Exam Status names"_RADASH,!,?$L(RADASH),"within : ",RAIMGTYJ
125 S RAORDXNM=0 F I=0,1,9 D Q:RAOUT
126 . S J=$O(^RA(72,"AA",RAIMGTYJ,I,""))
127 . I I=0,($P(^RA(72,J,0),U)="CANCELLED") Q
128 . I I=1,($P(^RA(72,J,0),U)="WAITING FOR EXAM") Q
129 . I I=9,($P(^RA(72,J,0),U)="COMPLETE") Q
130 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
131 . W !!?5,"Warning : The status with order number '"_I_"' was"
132 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
133 . W !?5,"named '"_$S(I=0:"CANCELLED",I=1:"WAITING FOR EXAM",1:"COMPLETE")_"', but is now named '",$P(^RA(72,J,0),U),"'",$C(7)
134 . S RAORDXNM=1
135 Q:(RAOUT!RAORDXNM)
136 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
137 W !!?5,"Exam Status names check complete"
138 Q
Note: See TracBrowser for help on using the repository browser.