source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SD53142.m@ 1679

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1SD53142 ;BP/JRP - POST INIT FOR PATCH SD*5.3*142;9-APR-1998
2 ;;5.3;Scheduling;**142**;AUG 13, 1993
3 ;
4 ;Portions of this routine were copied from SD5370PT (ALB/ABR)
5 ; and SCMSP66 (ALB/JLU)
6 ;
7PRE ;Main entry point for pre init
8 ;Remove ERROR CODE DESCRIPTION (field #11) as an identifier of the
9 ; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76)
10 ; (this causes problems when installing error codes)
11 I ($D(^DD(409.76,0,"ID",11))) D
12 .N TMP
13 .K ^DD(409.76,0,"ID",11)
14 .Q:($D(^DD(409.76,0,"ID")))
15 .S TMP=$P(^SD(409.76,0),U,2)
16 .S TMP=$TR(TMP,"I","")
17 .S $P(^SD(409.76,0),U,2)=TMP
18 .Q
19 Q
20 ;
21POST ;Main entry point for post init
22 ;Make ERROR CODE DESCRIPTION (field #11) an identifier of the
23 ; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76)
24 ; (this was removed by the pre init routine)
25 I ('$D(^DD(409.76,0,"ID",11))) D
26 .N TMP
27 .S ^DD(409.76,0,"ID",11)="D EN^DDIOL($P(^(1),U,1))"
28 .S TMP=$P(^SD(409.76,0),U,2)
29 .S TMP=$TR(TMP,"I","")
30 .S $P(^SD(409.76,0),U,2)=TMP_"I"
31 ;Change status of HL7 messages
32 D HLM
33 ;Change HL7 application name
34 D HLAPP
35 Q
36 ;
37HLM ;Change status of HL7 messages to '3' (SUCCESSFULLY COMPLETED)
38 ; to enable purging of message
39 N DA,DIC,DIE,DR,X,Y,SDAPP,HLMID,XPDIDTOT,HLPTR,COUNT,TEXT
40 S X=$$NOW^XLFDT()
41 S Y=$$FMTE^XLFDT(X)
42 S TEXT=">> Beginning HL7 Message Text file (#772) update on "
43 S TEXT=TEXT_$P(Y,"@",1)_" @ "_$P(Y,"@",2)
44 D BMES^XPDUTL(TEXT)
45 S XPDIDTOT=+$O(^HL(772,"A"),-1)
46 S DIC="^HL(771,"
47 S DIC(0)="M"
48 S X="AMBCARE-DH70"
49 D ^DIC
50 I (Y<0) D Q
51 .D BMES^XPDUTL(" *** AMBCARE-DH70 application not found ***")
52 S SDAPP=+Y
53 S HLMID=""
54 S COUNT=0
55 F S HLMID=$O(^HL(772,"AH",SDAPP,HLMID)) Q:(HLMID="") D
56 .S HLPTR=0
57 .F S HLPTR=+$O(^HL(772,"AH",SDAPP,HLMID,HLPTR)) Q:('HLPTR) D
58 ..D UPDATE^XPDID(HLPTR)
59 ..S DIE="^HL(772,"
60 ..S DA=HLPTR
61 ..S DR="20////3"
62 ..D ^DIE
63 ..S COUNT=COUNT+1
64 D UPDATE^XPDID(XPDIDTOT)
65 S X=$$NOW^XLFDT()
66 S Y=$$FMTE^XLFDT(X)
67 S TEXT=" Updating of HL7 Message Text file completed on "
68 S TEXT=TEXT_$P(Y,"@",1)_" @ "_$P(Y,"@",2)
69 D MES^XPDUTL(TEXT)
70 S TEXT=" "_COUNT_" entries were updated"
71 D MES^XPDUTL(TEXT)
72 Q
73 ;
74HLAPP ;Change HL7 application name from AMBCARE-DH70 to AMBCARE-DH142
75 N DIE,DIC,DA,DR,X,Y
76 D BMES^XPDUTL(">> Changing HL7 Application name from AMBCARE-DH70 to AMBCARE-DH142")
77 S DIC="^HL(771,"
78 S DIC(0)="X"
79 S X="AMBCARE-DH70"
80 D ^DIC
81 I (Y<0) D Q
82 .D BMES^XPDUTL(" *** AMBCARE-DH70 application not found ***")
83 S DIE=DIC
84 S DA=+Y
85 S DR=".01///AMBCARE-DH142"
86 D ^DIE
87 D MES^XPDUTL(" HL7 application name successfully changed to AMBCARE-DH142")
88 Q
89 ;
90 ;
91DEL6050 ;Delete entries in Transmitted Outpatient Encounter file (#409.73)
92 ;that are Lab stops to an OOS clinic and don't have any CPTs. Net
93 ;result is removal of 6050 errors from error listing.
94 ;
95 N IOP
96 S IOP="Q"
97 D EN^XUTMDEVQ("TASK6050^SD53142","DELETE ACRP 6050 ERRORS")
98 D HOME^%ZIS
99 Q
100TASK6050 ;Entry point for tasking
101 ;Declare variables
102 N L,DIC,FLDS,BY,FR,TO,DHD,DHIT,IOP,SD53142
103 ;Sort through Transmitted Outpatient Encounter Error file (#409.75)
104 S L=""
105 S DIC="^SD(409.75,"
106 ;Find entries that match the following criteria:
107 ; (1) Error code is 6050
108 ; (2) Related Visit file entry is a Lab stop
109 ; (3) Related Visit file entry is at an OOS clinic
110 S BY="@.02,@.01:.02:.05:.08:1,@.01:.02:.05:.22:50.01"
111 S FR(1)="6050"
112 S TO(1)="6050"
113 S FR(2)="108"
114 S TO(2)="108"
115 S FR(3)="YES"
116 S TO(3)="YES"
117 ;Print basic information about the entry
118 S FLDS="INTERNAL(#.01);""XMITPTR"""
119 S FLDS(1)=".01:.02:INTERNAL(NUMBER);""ENCPTR"""
120 S FLDS(2)=".01:.02:.05:INTERNAL(NUMBER);""VSITPTR"""
121 S FLDS(3)=".01:.02:.05:NUMDATE(#.01);""DATE"""
122 S FLDS(4)=".01:.02:.05:15001;L10;""VISIT ID"""
123 S FLDS(5)=".01:.02:.05:.08:1;L4;""AMIS"""
124 S FLDS(6)=".01:.02:.05:.22;L16;""CLINIC"""
125 ;Delete entry from Transmitted Outpatient Encounter file
126 S DHIT="S ZJRP=$$DELXMIT^SCDXFU03(+$G(^SD(409.75,D0,0)),0) K ZJRP"
127 ;Send output to current device
128 S IOP=IO
129 ;Remember IO("S")
130 S SD53142=+$G(IO("S"))
131 ;Call FileMan
132 S DHD="6050 ERRORS DELETED FROM ACRP FILES"
133 D EN1^DIP
134 ;Reset IO("S")
135 S:(SD53142) IO("S")=SD53142
136 ;Done
137 S:($D(ZTQUEUED)) ZTREQ="@"
138 Q
Note: See TracBrowser for help on using the repository browser.