source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCYP31.m@ 1071

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1GMRCYP31 ;SLC/JFR - POST-INIT FOR PATCH 31; 2/04/03 08:02
2 ;;3.0;CONSULT/REQUEST TRACKING;**31,32**;DEC 27, 1997
3 ;
4 ; Re-distributed with GMRC*3*32 to address error with no records
5 ; to print when sent to a printer.
6 Q
7POST ;
8 N %ZIS,GMRCQT,POP
9 W !!,"This report should be sent to a printer",!
10 S %ZIS="" D ^%ZIS
11 I POP Q
12 I $D(IO("Q")) D Q
13 . N ZTRTN,ZTDTH,ZTIO,ZTSAVE,ZTDESC
14 . S ZTRTN="POST1^GMRCYP31",ZTIO=ION,ZTDTH=$H
15 . S ZTDESC="GMRC*3*31 Post-Install Report"
16 . D ^%ZTLOAD D HOME^%ZIS K IO("Q") Q
17 . W !,"REPORT TASKED TO PRINT!"
18 . Q
19 D POST1
20 Q
21POST1 ; START POST-INIT
22 N GMRCO,GMRCISIT,GMRCRO
23 S GMRCISIT=0
24 F S GMRCISIT=$O(^GMR(123,"AIFC",GMRCISIT)) Q:'GMRCISIT D
25 . S GMRCRO=0
26 . F S GMRCRO=$O(^GMR(123,"AIFC",GMRCISIT,GMRCRO)) Q:'GMRCRO D
27 .. S GMRCO=$O(^GMR(123,"AIFC",GMRCISIT,GMRCRO,0))
28 .. I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D
29 ... D ACTS(GMRCO)
30 ... I $D(^TMP("GMRCYP31",$J,GMRCISIT,GMRCO)) D
31 .... S ^TMP("GMRCYP31",$J,GMRCISIT,GMRCO)=""
32 .. Q
33 . Q
34 D PRINT
35 Q
36 ;
37ACTS(CSLT) ;loop activities and see if there is a remote FWD or SF update
38 ;CSTL = ien from file 123
39 N ACTV
40 S ACTV=0
41 F S ACTV=$O(^GMR(123,CSLT,40,ACTV)) Q:'ACTV D
42 . N ACTYPE
43 . S ACTYPE=$P(^GMR(123,CSLT,40,ACTV,0),U,2)
44 . Q:ACTYPE'=17&(ACTYPE'=4) ;only FWD and SF are affected
45 . Q:'$D(^GMR(123,CSLT,40,ACTV,2)) ;only remote activities
46 . Q:'$O(^GMR(123,CSLT,40,ACTV,1,1)) ;only comments >1 line long
47 . N SITE
48 . S SITE=$P(^GMR(123,CSLT,0),U,23)
49 . S ^TMP("GMRCYP31",$J,SITE,CSLT,ACTV,0)=""
50 Q
51 ;
52PRINT ; loop the ^TMP global and write records
53 ; ask device and queue if needed
54 ;
55 ;I $D(ZTQUEUED) S ZTREQ="@"
56 N GMRCCT,TAB,GMRCDA,GMRCSIT,ACT,REMNUM,GMRCPG
57 U IO
58 S GMRCPG=1
59 D HDR(.GMRCPG)
60 I '$O(^TMP("GMRCYP31",$J,0)) D D ^%ZISC,HOME^%ZIS Q
61 . W !,"No records to report"
62 . I $E(IOST,1,2)="C-" N DIR S DIR(0)="E" D ^DIR
63 . Q
64 S TAB=$$REPEAT^XLFSTR(" ",29)
65 W !,"No cleanup or modification should be made to Inter-facility consults that are "
66 W !,"identified with extraneous comments at this time. Patch GMRC*3*32 will outline"
67 W !,"the processes that should be utilized to properly accomplish these corrections."
68 W !,$$REPEAT^XLFSTR("*",79)
69 W !!
70 S GMRCSIT=0
71 F S GMRCSIT=$O(^TMP("GMRCYP31",$J,GMRCSIT)) Q:'GMRCSIT D
72 . S GMRCDA=0
73 . F S GMRCDA=$O(^TMP("GMRCYP31",$J,GMRCSIT,GMRCDA)) Q:'GMRCDA D
74 .. I (IOSL-$Y)<7 D HDR(.GMRCPG) I 'GMRCPG S GMRCDA=999999999 Q
75 .. N PTNM,PTSSN,REMSIT
76 .. S PTNM="Patient name: "_$$GET1^DIQ(123,GMRCDA,.02,"E")
77 .. S PTSSN="SSN: "_$$GET1^DIQ(2,$P(^GMR(123,GMRCDA,0),U,2),.09)
78 .. S REMSIT=$$GET1^DIQ(4,$P(^GMR(123,GMRCDA,0),U,23),.01)
79 .. S REMNUM=$P(^GMR(123,GMRCDA,0),U,22)
80 .. I GMRCPG>2 W !,$$REPEAT^XLFSTR("*",78)
81 .. W !,"Consult #: ",GMRCDA
82 .. W !,PTNM,?50,PTSSN
83 .. W !,"Receiving Site: ",REMSIT,?50,"Remote Consult #: ",REMNUM
84 .. W !!,$$CJ^XLFSTR("Activities for Review",78)
85 .. W !,$$CJ^XLFSTR("*********************",78)
86 .. I (IOSL-$Y)<4 D HDR(.GMRCPG) I 'GMRCPG S GMRCDA=999999999 Q
87 .. W !,"Facility"
88 .. W !," Activity",?25,"Date/Time/Zone",$E(TAB,1,6)
89 .. W "Responsible Person",$E(TAB,1,2),"Entered By"
90 .. W !,$$REPEAT^XLFSTR("-",79)
91 .. S ACT=0
92 .. F S ACT=$O(^TMP("GMRCYP31",$J,GMRCSIT,GMRCDA,ACT)) Q:'ACT D
93 ... N GMRCCT S GMRCCT=1
94 ... I (IOSL-$Y)<6 D HDR(.GMRCPG,GMRCDA) I 'GMRCPG D Q
95 .... S (ACT,GMRCDA)=9999999999
96 ... W !,?11,"Act. #:",ACT
97 ... D BLDALN^GMRCSLM4(GMRCDA,ACT)
98 ... N I S I=0
99 ... F S I=$O(^TMP("GMRCR",$J,"DT",I)) Q:'I D
100 .... I (IOSL-$Y)<5 D HDR(.GMRCPG,GMRCDA) I 'GMRCPG D Q
101 ..... S (I,ACT,GMRCDA)=9999999999
102 .... W !,$G(^TMP("GMRCR",$J,"DT",I,0))
103 ... K ^TMP("GMRCR",$J,"DT")
104 .. W !
105 .. Q
106 . Q
107 D ^%ZISC,HOME^%ZIS
108 D EXIT
109 Q
110 ;
111HDR(PAGE,CSLT) ;print a new header
112 ; PAGE = next page number
113 ; CSLT = consult ien working on
114 ;
115 I $E(IOST,1,2)="C-",PAGE>1 D I 'PAGE Q
116 . N DIR,DIROUT,DIRUT,DTOUT,DUOUT
117 . S DIR(0)="E" D ^DIR
118 . I $D(DIRUT) S PAGE=0
119 W @IOF
120 W !,"GMRC*3*31 Post-Install",?69,"Page: ",PAGE
121 W !,$$REPEAT^XLFSTR("-",79)
122 I $D(CSLT) D
123 . N TEXT
124 . S TEXT="Consult # "_CSLT_" cont'd."
125 . W !,$$CJ^XLFSTR(TEXT,80)
126 . W !
127 S PAGE=PAGE+1
128 Q
129EXIT ; clean up
130 K ^TMP("GMRCYP31",$J)
131 Q
Note: See TracBrowser for help on using the repository browser.