source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCONS1.m@ 1432

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

initial load of WorldVistAEHR
File size: 7.6 KB
RevLine 
[613]1GMRCONS1 ;ALB/MRY - Consult/Scheduling link report ;4/10/06 14:21
2 ;;3.0;CONSULT/REQUEST TRACKING;**52**;DEC 27, 1997
3EN ;
4 K GMRNOSRV D SERV Q:$D(GMRNOSRV)
5 D EN^VALM("GMRC SD PENDING CONSULTS")
6 Q
7SERV I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
8 K GMRRS,STAT,DIC,TOT,TOTAL
9 S TOTAL=0,DIC=123.5,DIC(0)="QAEMZ",DIC("A")="Select Service/Specialty: ",D="B^D" D MIX^DIC1 K DIC S:Y=-1 GMRNOSRV="" Q:Y=-1
10 K ST,STAT S SRVNM=Y(0,0),RS=+Y,ST="",ORD=0 F S ORD=$O(^ORD(100.01,ORD)) Q:'+ORD S STAT(ORD)=$P(^ORD(100.01,ORD,0),U)
11SD S %DT="EAT",%DT("A")="Enter Starting Date: " D ^%DT S:Y=-1 GMRNOSRV="" Q:Y=-1 S PSD=Y,SD=Y-.01
12 S %DT="EAT",%DT("A")="Enter Ending Date: " D ^%DT S:Y=-1 GMRNOSRV="" Q:Y=-1 S ED=Y_.24
13 I ED<SD W !!,$C(7),"Ending Date Can Not Be Before Starting Date.",! G SD
14 Q
15START D WAIT^DICD K ^TMP($J),^TMP("GMRCR",$J) S GMRRS("RS",RS)="",CS=RS D SERVICE
16 S GRP=0 F S GRP=$O(^GMR(123.5,RS,10,GRP)) Q:'+GRP S CS=$P(^GMR(123.5,RS,10,GRP,0),U) I $P(^GMR(123.5,CS,0),U,2)'=9 S GMRRS("RS",CS)="" D SERVICE
17 K ST F I="COMPLETE","DISCONTINUED","PENDING","ACTIVE","SCHEDULED","PARTIAL RESULTS","DISCONTINUED/EDIT","CANCELLED" S TOT(I)=0
18 S SDI=SD F S SDI=$O(^GMR(123,"E",SDI)) Q:'+SDI!(SDI>ED) S GIEN=0 F S GIEN=$O(^GMR(123,"E",SDI,GIEN)) Q:'+GIEN S ND=^GMR(123,GIEN,0),SERV=$P(ND,U,5),STATUS=$P(ND,U,12) I SERV'="",$D(GMRRS("RS",SERV)),$D(STAT(STATUS)) D
19 .S LSTACT=$P($G(^GMR(123.1,$P(ND,U,13),0)),U),PTIEN=$P(ND,U,2),ATDPT=$G(^DPT(PTIEN,0)),PTNM=$P(ATDPT,U),L4=$E($P(ATDPT,U,9),6,9),SRVCON=$P($G(^DPT(PTIEN,.3)),U,2),SRVCON=$S(SRVCON="":"",1:SRVCON_"%")
20 .S AWAS1=$S($D(^SC("AWAS1",GIEN)):"LINKED",1:"NOT LINKED"),AHST1=$S($D(^SC("AHST1",GIEN)):"HAS HISTORY",1:"NO HISTORY"),STATS=$P(STAT(STATUS),U)
21 .S ^TMP($J,"S",STATS,SDI,GIEN)=PTNM_U_PTIEN_U_LSTACT_U_AWAS1_U_AHST1_U_SERV_U_STATS_U_SDI_U_L4_U_SRVCON
22 .S:$D(TOT(STATS)) TOT(STATS)=TOT(STATS)+1 S:'$D(TOT(STATS)) TOT(STATS)=1 S TOTAL=TOTAL+1
23 D ^GMRCONS2
24EXIT2 K A,ACT,AD,AHST1,ATDPT,AW,AWAS1,B,CHKOT,CLNC,CMMT,CS,CSS,ED,EN,EN2,GIEN,GMRND,GRP,GXHEC,H2,HEC,HECA,HEX,I,L4,LC,LGTH,LGTH1,LSTACT,ND,ORD,ORDATE,P3,P8,P9,PTIEN,PTNM,RS,S,SC,SCDT,SCLNC,SD,SDI,SDWL,SDWLND,SERV
25 K SIEN,ST,STAT,STATUS,STOPCD,STPCOD,SUM,SUM2,TEXT,TND,TOT,TOTALTX,TYPE
26 K BB,C,CLNCNM,D,GMRRS,SRV,SRVNM,STATS,SUBTOT,TOTAL,TX
27 K PD,PSD
28 K ASP8,ASP9,CMHD,CNSDT,CNSLT,CNSLTND,DIC,P4,POP,PRTCNDT,SRVCON,STCD,X,Y
29 Q
30SERVICE ;
31 S STPCLNC="",SC=0 F S SC=$O(^GMR(123.5,CS,688,SC)) Q:'+SC S STPCOD=$P(^GMR(123.5,CS,688,SC,0),U) I STPCOD'="" S STPCLNC=$P(^DIC(40.7,STPCOD,0),U)_","_STPCLNC
32 S SC=0 F S SC=$O(^GMR(123.5,CS,688,SC)) Q:'+SC S STPCOD=$P(^GMR(123.5,CS,688,SC,0),U) I STPCOD'="" D
33 .S STPCOD=$P(^DIC(40.7,STPCOD,0),U,2) S:$D(^TMP($J,"SC",STPCOD)) ^TMP($J,"SC",STPCOD)=STPCLNC_^TMP($J,"SC",STPCOD) S:'$D(^TMP($J,"SC",STPCOD)) ^TMP($J,"SC",STPCOD)=STPCLNC
34 Q
35CLINIC ;
36 S CLNC=$P(^GMR(123.5,A,0),U) W @IOF,CLNC," (",A,")",!
37 Q
38ACTIVE I '$D(^SC("AHST1",CS)) D ASP D Q
39 .I ASP9 S ^TMP($J,"A","ACTWOLHWL")=^TMP($J,"A","ACTWOLHWL")+1,^TMP($J,"A","ACTWOLHWL",SRV,AD,CS)=TND,WL="" D KILNODE Q
40 .I ASP8 S ^TMP($J,"A","ACTWOLHWL")=^TMP($J,"A","ACTWOLHWL")+1,^TMP($J,"A","ACTWOLHWL",SRV,AD,CS)=TND,WL="" D KILNODE Q
41 .I '$D(WL) D
42 ..I $P($G(^GMR(123,CS,12)),U,5)="P" D
43 ...S ^TMP($J,"A","ACTWOLHIFC")=^TMP($J,"A","ACTWOLHIFC")+1,^TMP($J,"A","ACTWOLHIFC",SRV,AD,CS)=TND
44 ..E D
45 ...S ^TMP($J,"A","ACTWOLHNWL",SRV,AD,CS)=TND,^TMP($J,"A","ACTWOLHNWL")=^TMP($J,"A","ACTWOLHNWL")+1
46 ..D KILNODE Q
47 I LSTACT="EDIT/RESUBMITTED"!(LSTACT="ADDED COMMENT")!(LSTACT="STATUS CHANGE") K FND S EN2=$O(^GMR(123,CS,40,":"),-1),EN=":" F S EN=$O(^GMR(123,CS,40,EN),-1) Q:'+EN!($D(FND)) D EDITRSB
48 Q
49SCHEDULE I '$D(^SC("AHST1",CS)) D ASP D Q
50 .I ASP9 S ^TMP($J,"A","SCHWOLHWL")=^TMP($J,"A","SCHWOLHWL")+1,^TMP($J,"A","SCHWOLHWL",SRV,AD,CS)=TND,WL="" D KILNODE Q
51 .I ASP8 S ^TMP($J,"A","SCHWOLHWL")=^TMP($J,"A","SCHWOLHWL")+1,^TMP($J,"A","SCHWOLHWL",SRV,AD,CS)=TND,WL="" D KILNODE Q
52 .I '$D(WL) D
53 ..I $P($G(^GMR(123,CS,12)),U,5)="P" D
54 ...S ^TMP($J,"A","SCHWOLHIFC")=^TMP($J,"A","SCHWOLHIFC")+1,^TMP($J,"A","SCHWOLHIFC",SRV,AD,CS)=TND
55 ..E D
56 ...S ^TMP($J,"A","SCHWOLHNWL",SRV,AD,CS)=TND,^TMP($J,"A","SCHWOLHNWL")=^TMP($J,"A","SCHWOLHNWL")+1
57 ..D KILNODE Q
58 I $D(^SC("AWAS1",CS)) S AW="AWAS1" K FND S SCLNC=$O(^SC(AW,CS,":"),-1),SCDT=$O(^SC(AW,CS,SCLNC,":"),-1),SIEN=$O(^SC(AW,CS,SCLNC,SCDT,":"),-1),CSS=$P($G(^SC(SCLNC,"S",SCDT,1,SIEN,"CONS")),U) D Q
59 .I CSS=CS S CHKOT=$P($G(^SC(SCLNC,"S",SCDT,1,SIEN,"C")),U,3) D
60 ..I CHKOT'="" S ^TMP($J,"A","SCHWALCO")=^TMP($J,"A","SCHWALCO")+1,^TMP($J,"A","SCHWALCO",SRV,AD,CS)=TND D KILNODE Q
61 ..I CHKOT="" S ^TMP($J,"A","SCHWALNCO")=^TMP($J,"A","SCHWALNCO")+1,^TMP($J,"A","SCHWALNCO",SRV,AD,CS)=TND D KILNODE Q
62 I $D(^SC("AHST1",CS))&('$D(^SC("AWAS1",CS))) S ^TMP($J,"A","SCHWHNAL")=^TMP($J,"A","SCHWHNAL")+1,^TMP($J,"A","SCHWHNAL",SRV,AD,CS)=TND D KILNODE
63 Q
64PENDING D ASP D
65 .I ASP9 S ^TMP($J,"A","PENWL")=^TMP($J,"A","PENWL")+1,^TMP($J,"A","PENWL",SRV,AD,CS)=TND,WL="" D KILNODE Q
66 .I ASP8 S ^TMP($J,"A","PENWL")=^TMP($J,"A","PENWL")+1,^TMP($J,"A","PENWL",SRV,AD,CS)=TND,WL="" D KILNODE Q
67 I '$D(WL) S ^TMP($J,"A","PENNWL")=^TMP($J,"A","PENNWL")+1,^TMP($J,"A","PENNWL",SRV,AD,CS)=TND D KILNODE
68 Q
69ASP ;
70 S ASP9=0,ASP8=0,STAT="",SDWL=0 F S SDWL=$O(^SDWL(409.3,"B",PTIEN,SDWL)) Q:'+SDWL S SDWLND=$G(^SDWL(409.3,SDWL,0)),STAT=$P(SDWLND,U,17),ORDATE=$P(SDWLND,U,2) D Q:$D(WL)
71 .S P9=$P(SDWLND,U,9),P8=$P(SDWLND,U,8)
72 .I P9'="" S CLNC=$P(^SDWL(409.32,P9,0),U) I CLNC'="" S STCD=$P(^SC(CLNC,0),U,7) I STCD'="" S STOPCD=$P(^DIC(40.7,STCD,0),U,2),CLNC2=$P(^DIC(40.7,STCD,0),U) D:$D(^TMP($J,"SC",STOPCD)) Q
73 ..I STAT="O"&(ORDATE=$P(AD,".")!(ORDATE>AD))&(STPCLNC[CLNC2) S ASP9=1 Q
74 .I P8'="" S CLNC=$P(^SDWL(409.31,P8,0),U) I CLNC'="" S STOPCD=$P(^DIC(40.7,CLNC,0),U,2),CLNC2=$P(^DIC(40.7,CLNC,0),U) I STOPCD'="" D:$D(^TMP($J,"SC",STOPCD)) Q
75 ..I STAT="O"&(ORDATE=$P(AD,".")!(ORDATE>AD))&(STPCLNC[CLNC2) S ASP8=1 Q
76 Q
77INCMPLTE S ^TMP($J,"A","INCMPLTE")=^TMP($J,"A","INCMPLTE")+1,^TMP($J,"A","INCMPLTE",SRV,AD,CS)=TND
78 Q
79CANCELED S ^TMP($J,"A","CANCELED")=^TMP($J,"A","CANCELED")+1,^TMP($J,"A","CANCELED",SRV,AD,CS)=TND
80 Q
81DSCNTUED S ^TMP($J,"A","DSCNTUED")=^TMP($J,"A","DSCNTUED")+1,^TMP($J,"A","DSCNTUED",SRV,AD,CS)=TND
82 Q
83COMPLETE S ^TMP($J,"A","COMPLETE")=^TMP($J,"A","COMPLETE")+1,^TMP($J,"A","COMPLETE",SRV,AD,CS)=TND
84 Q
85CLOSE S ^TMP($J,"A","CLOSE")=^TMP($J,"A","CLOSE")+1,^TMP($J,"A","CLOSE",SRV,AD,CS)=TND
86 Q
87TOC S ^TMP($J,"A","TOC")=^TMP($J,"A","TOC")+1,^TMP($J,"A","TOC",SRV,AD,CS)=TND
88 Q
89TCC S ^TMP($J,"A","TCC")=^TMP($J,"A","TCC")+1,^TMP($J,"A","TCC",SRV,AD,CS)=TND
90 Q
91EDITRSB S GMRND=^GMR(123,CS,40,EN,0),ACT=$P(GMRND,U,2),ACT=$P(^GMR(123.1,ACT,0),U)
92 S:(ACT'="EDIT/RESUBMITTED")!(ACT'="STATUS CHANGE") EN2=EN I (ACT="EDIT/RESUBMITTED")!(ACT="STATUS CHANGE") D
93 .S CMMT=$G(^GMR(123,CS,40,EN2,1,1,0))
94ACTERNS .I CMMT["was a no-show" S ^TMP($J,"A","ACTERNS")=^TMP($J,"A","ACTERNS")+1,^TMP($J,"A","ACTERNS",SRV,AD,CS)=TND,FND="" D KILNODE Q
95ACTERCP .I CMMT["was cancelled by the Patient" S ^TMP($J,"A","ACTERCP")=^TMP($J,"A","ACTERCP")+1,^TMP($J,"A","ACTERCP",SRV,AD,CS)=TND,FND="" D KILNODE Q
96ACTERCC .I CMMT["was cancelled by the Clinic"!(CMMT["was cancelled, whole clinic") S ^TMP($J,"A","ACTERCC")=^TMP($J,"A","ACTERCC")+1,^TMP($J,"A","ACTERCC",SRV,AD,CS)=TND,FND="" D KILNODE Q
97ACTERAP .I CMMT["was cancelled for" S ^TMP($J,"A","ACTERAP")=^TMP($J,"A","ACTERAP")+1,^TMP($J,"A","ACTERAP",SRV,AD,CS)=TND,FND="" D KILNODE Q
98ACTEROW .S ^TMP($J,"A","ACTEROW")=^TMP($J,"A","ACTEROW")+1,^TMP($J,"A","ACTEROW",SRV,AD,CS)=TND,FND="" D KILNODE Q
99 Q
100KILNODE K ^TMP($J,"S",ST,AD,CS)
101 Q
102CHKLIN I ($Y>(IOSL-4)) S HLD="" D PROMPT Q:HLD[U X CMHD S PG=PG+1
103 Q
104IOSL Q:($Y>(IOSL-3))
105PROMPT I IOST["C-" R !!,"Press enter to continue or '^' to exit. ",HLD:DTIME S PROMPT="" I HLD[" " S HLD=U
106 Q
Note: See TracBrowser for help on using the repository browser.