close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SD53P317.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SD53P317.m@ 846

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

initial load of WorldVistAEHR
File size: 6.2 KB
RevLine 
1SD53P317 ;ALB/JAM - Restricting Stop Code Post-Init Rtn ; 0707/03
2 ;;5.3;Scheduling;**317**;AUG 13, 1993
3 ;
4POST ; entry point
5 ;* Appropriating Stop Code fl #40.7 entries with restriction type & date
6 N SDJ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTREQ,ZTSAVE
7 I $D(^UTL("STPCODE")) K ^UTL("STPCODE")
8 S SDJ=$J
9 D MES^XPDUTL(" ")
10 D BMES^XPDUTL("This post install process does the following:-")
11 D BMES^XPDUTL(" 1. Appropriates Stop Code entries in CLINIC STOP file (#40.7) with a ")
12 D MES^XPDUTL(" Restriction Type and Date.")
13 D BMES^XPDUTL(" 2. Check clinics in file #44 for nonconforming Stop Codes and produces")
14 D MES^XPDUTL(" a MailMan message.")
15 D MES^XPDUTL(" ")
16 ;read and store stop codes in ^UTILITY("STPCODE",SDJ,
17 D ^SDSTPD1
18 ;assign stop code restriction type and restriction date
19 D STPMOD
20 ;check file #44 for non-conforming restriction type
21 S ZTRTN="PROCESS^SD53P317"
22 S ZTDESC="Non-Conforming Clinics Restricted Stop Code Report"
23 S ZTIO="",ZTDTH=$H,ZTREQ="@" D ^%ZTLOAD
24 D MES^XPDUTL(" ")
25 D BMES^XPDUTL("completed...")
26 D MES^XPDUTL(" ")
27 K ^UTILITY("STPCODE")
28 Q
29STPMOD ;* designate stop codes in file 40.7 as primary, secondary or either
30 ;
31 ; SDXX is in format:
32 ; STOP CODE^NAME^RESTRICTION TYPE^RESTRICTION DATE^INACTIVE DATE
33 ;
34 N SDX,SDXX,NAME,CODE,RESTY,RESDT,X,Y,DIC,DIE,DA,DR,IEN,INACT
35 D BMES^XPDUTL("Adding Restricted Type and Restricted Date to CLINIC STOP File (#40.7)...")
36 D MES^XPDUTL(" ")
37 S SDX=0 F S SDX=$O(^UTILITY("STPCODE",SDJ,SDX)) Q:'SDX S SDXX=^(SDX) D
38 .S CODE=$P(SDXX,U),NAME=$P(SDXX,U,2),RESTY=$P(SDXX,U,3)
39 .S RESDT=$P(SDXX,U,4),INACT=$P(SDXX,U,5)
40 .I '$D(^DIC(40.7,"C",CODE)) S ^TMP("STPCD",$J,CODE)=SDXX Q
41 .S IEN=$O(^DIC(40.7,"C",CODE,0)) I 'IEN Q
42 .I '$D(^DIC(40.7,IEN,0)) S ^TMP("STPCD",$J,CODE)=SDXX Q
43 .S IEN=0 F S IEN=$O(^DIC(40.7,"C",CODE,IEN)) Q:'IEN D FILSC
44 .W !,?2,CODE,?7,NAME,?40,"National Code Updated...."
45 D MES^XPDUTL(" ")
46 S RESTY="S" F SDX=450:1:485 D
47 .Q:'$D(^DIC(40.7,"C",SDX)) S IEN=$O(^DIC(40.7,"C",SDX,0)) I 'IEN Q
48 .Q:'$D(^DIC(40.7,IEN,0)) S SDXX=^(0) S RESDT="10/1/2003"
49 .S IEN=0 F S IEN=$O(^DIC(40.7,"C",SDX,IEN)) Q:'IEN D FILSC
50 .W !,?2,SDX,?7,$P(SDXX,U),?40,"Local Code Updated...."
51 D MES^XPDUTL(" ")
52 S CODE="" F S CODE=$O(^TMP("STPCD",$J,CODE)) Q:CODE="" D
53 .S SDX=^TMP("STPCD",$J,CODE),NAME=$P(SDX,U,2)
54 .S RESTY=$P(SDXX,U,3),RESDT=$P(SDXX,U,4),INACT=$P(SDXX,U,5)
55 .W !,?2,CODE,?7,NAME,?40,"Problematic....code not in file 40.7"
56 D MES^XPDUTL(" ")
57 S IEN=0 F S IEN=$O(^DIC(40.7,IEN)) Q:'IEN D
58 .S SDXX=$G(^DIC(40.7,IEN,0)) Q:SDXX="" Q:$P(SDXX,U,6)'=""
59 .W !,?2,$P(SDXX,U,2),?7,$E($P(SDXX,U),1,30),?40,"Missing Restriction Type."
60 Q
61 ;
62FILSC ;Update stop code in file 40.7
63 S DIE="^DIC(40.7,"
64 S DA=IEN,DR="5////"_RESTY_";6///"_RESDT D ^DIE
65 Q
66 ;
67PROCESS ;background entry point
68 ; Locate invalid Stop Code in file 44 & 728.44 and put in a mail message
69 N SDX,IEN,BLN,COUNT,TXTVAR,I,LNS,CNT,STR,SDJ,PSC,SSC,DPC,DSC,CNTX,NAM
70 N SCN,PSCN,SSCN,DPCN,DSCN,IDT
71 S COUNT=0,$P(BLN," ",60)="",$P(LNS,"-",80)=""
72 S SDJ=$J K ^TMP(SDJ,"SD53P309")
73 F I=1:1 S TXTVAR=$P($T(MSGTXT+I),";;",2) Q:TXTVAR="QUIT" D LINE(TXTVAR)
74 D CK44
75 D MAIL
76 K ^TMP(SDJ,"SD53P309"),TEXT,TYP
77 Q
78 ;
79CK44 ;Check file 44 for invalid stop codes.
80 N RDT,IDAT
81 S (CNTX,IEN)=0
82 D HDR
83 ;search file #44 for invalid entries
84 F S IEN=$O(^SC(IEN)) Q:'IEN D
85 .K STR S SDX=$G(^SC(IEN,0)),PSC=$P(SDX,U,7),SSC=$P(SDX,U,18),CNT=1
86 .I $P(SDX,U,3)'="C" Q
87 .S NAM=$P(SDX,U),IDAT=$G(^SC(IEN,"I")) I IDAT'="" D
88 ..S IDT=$P(IDAT,U),RDT=$P(IDAT,U,2) Q:IDT="" I RDT="" S NAM="*"_NAM Q
89 ..I RDT>IDT S NAM="*"_NAM
90 .S (PSCN,SSCN)="" D
91 ..I PSC="" S STR(CNT)="Missing primary code",CNT=CNT+1 Q
92 ..S PSCN=$$SCNUM(PSC)
93 ..I PSCN="" S STR(CNT)=PSC_" has Inv pri ptr",CNT=CNT+1 Q
94 ..D SCCHK(PSC,"P")
95 .I SSC'="" D
96 ..S SSCN=$$SCNUM(SSC)
97 ..I SSCN="" S STR(CNT)=SSC_" has Inv 2nd ptr",CNT=CNT+1 Q
98 ..D SCCHK(SSC,"S")
99 .I $O(STR(0))'="" D LINE(.STR,"P") S CNTX=CNTX+1
100 D LINE(" ")
101 S STR=$E(BLN,1,25)_$S(CNTX:CNTX,1:"NO")_" PROBLEM CLINICS FOUND."
102 D LINE(STR)
103 D LINE(" ")
104 Q
105 ;
106SCNUM(SCIEN) ;Get stop code Number
107 I SCIEN="" Q ""
108 S SCN=$P($G(^DIC(40.7,SCIEN,0)),U,2)
109 Q SCN
110 ;
111SCIEN(SCN) ;Get stop code IEN
112 I SCN="" Q ""
113 S SCIEN=$O(^DIC(40.7,"C",SCN,0))
114 Q SCIEN
115 ;
116SCCHK(SCIEN,TYP) ;check stop code against file 40.7
117 N SCN,RTY,CTY
118 S CTY=$S(TYP="P":"^P^E^",1:"^S^E^")
119 S SCN=$G(^DIC(40.7,SCIEN,0)),RTY=$P(SCN,U,6),SCN=$P(SCN,U,2)
120 I SCN="" D D CNTR Q
121 .S STR(CNT)=SCIEN_" Invalid pointer."
122 I RTY="" S STR(CNT)=SCN_" No restriction type" D CNTR Q
123 I CTY'[("^"_RTY_"^") D
124 .S STR(CNT)=SCN_" cannot be "_$S(TYP="P":"prim",1:"second")_"ary"
125CNTR ;counter
126 S CNT=CNT+1
127 Q
128 ;
129HDR ;Header for data from file #44
130 D LINE(" ")
131 S STR="HOSPITAL LOCATION FILE (#44) - (Use Set up a Clinic [SDBUILD]"
132 S STR=STR_" menu option to"
133 D LINE(STR)
134 S STR=$E(BLN,1,32)_"make corrections)"
135 D LINE(STR)
136 D LINE(" ")
137 S STR=$E(BLN,1,35)_$E("PRIMARY"_BLN,1,10)
138 S STR=STR_$E("SECONDARY/"_BLN,1,11)_"REASON FOR"
139 D LINE(STR)
140 S STR=$E("CLINIC NAME"_BLN,1,35)_$E("STOP"_BLN,1,10)
141 S STR=STR_$E("CREDIT"_BLN,1,11)_"NON"
142 D LINE(STR)
143 S STR=$E("(* - currently inactive)"_BLN,1,35)_$E("CODE"_BLN,1,10)
144 S STR=STR_$E("STOP CODE"_BLN,1,11)_"CONFORMANCE"
145 D LINE(STR)
146 S STR=$E(LNS,1,80)
147 D LINE(STR)
148 Q
149 ;
150MSGTXT ; Message intro
151 ;; Please forward this message to your local MAS ADPAC.
152 ;;
153 ;; A review of the Primary and Secondary Stop Codes in the HOSPITAL
154 ;; LOCATION file (#44) was completed against the Restriction Type
155 ;; field (#5) of the CLINIC STOP file (#40.7) for nonconforming clinics.
156 ;;
157 ;;
158 ;;QUIT
159 ;
160 ;
161LINE(TEXT,TYP) ; Add line to message global
162 N FLN,STR,XI
163 ;build 1st line with name, codes, etc.
164 I $O(TEXT(0))'="" D Q
165 .S STR=$E(NAM_BLN,1,$S(TYP="P":35,1:21))
166 .S STR=STR_$E($$SCNUM(PSC)_BLN,1,$S(TYP="P":10,1:9))
167 .S STR=STR_$E($$SCNUM(SSC)_BLN,1,$S(TYP="P":11,1:9))
168 .I TYP="S" S STR=STR_$E($$SCNUM(DPC)_BLN,1,9)_$E($$SCNUM(DSC)_BLN,1,9)
169 .;set line in ^tmp global
170 .S XI=0 F S XI=$O(TEXT(XI)) Q:'XI D
171 ..;I XI'=FLN S TEXT(XI)=$E(BLN,1,57)_TEXT(XI)
172 ..S TEXT(XI)=STR_TEXT(XI)
173 ..S COUNT=COUNT+1,^TMP(SDJ,"SD53P309",COUNT)=TEXT(XI)
174 S COUNT=COUNT+1,^TMP(SDJ,"SD53P309",COUNT)=TEXT
175 Q
176 ;
177MAIL ; Send message
178 N XMDUZ,XMY,XMTEXT,XMSUB
179 S XMY(DUZ)="",XMDUZ=.5
180 S XMSUB="Non-Conforming Clinics Restricted Stop Codes"
181 S XMTEXT="^TMP(SDJ,""SD53P309"","
182 D ^XMD
183 Q
Note: See TracBrowser for help on using the repository browser.