source: WorldVistAEHR/trunk/r/POLICE_AND_SECURITY-ES/ESP122PT.m@ 691

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

initial load of WorldVistAEHR

File size: 7.6 KB
Line 
1ESP122PT ;ALB/JAP; POST-INSTALL FOR ES*1*22;3/98
2 ;;1.0;POLICE & SECURITY;**22**;Mar 31, 1994
3EN ;entry point
4 ;no harm is done if run multiple times
5 N ZTSK,ZTRTN,ZTDESC,ZTREQ,ZTSAVE,ZTIO,ZTDTH,ESPC,ESPU
6 D FILE1
7 D FILE2
8 D CONVERT
9 ;print conversion reports
10 S ESPION=$G(XPDQUES("POSPRINT","B"))
11 I ESPION=""!(ESPION["^") K ESPION
12 I $D(ESPION) S ZTIO=ESPION
13 S (ESPC,ESPU)=1 D NOW^%DTC S %=$E(%,1,12),ZTDTH=%+.001
14 S ZTRTN="PRINT^ESP122P1",ZTDESC="Print ES*1*22 Conversion Report",ZTREQ="@"
15 S ZTSAVE("ESPC")="",ZTSAVE("ESPU")="",ZTSAVE("ZTREQ")=""
16 D ^%ZTLOAD
17 I $G(ZTSK)>0 D
18 .W !!,"Conversion Reports queued as Task #",ZTSK,".",!!
19 I '$G(ZTSK) D
20 .W !!,"Unable to queue Conversion Reports.",!,"Use the Conversion Management print option later.",!!
21 K ESPION
22 Q
23 ;
24FILE1 ;add new entries to file #912.9
25 N I,J,TEXT,TYPE,CAT,DIC,DLAYGO,DINUM,X,Y,DIE,DR,DA
26 S DIC="^ESP(912.9,",DIC(0)="L",DLAYGO=912.9
27 F J=1:1:4 S TEXT=$P($T(NEWREC+J),";;",2) D
28 .S DINUM=$P(TEXT,U,1),X=$P(TEXT,U,2),TYPE=$P(TEXT,U,3),CAT=$P(TEXT,U,4)
29 .I $D(^ESP(912.9,DINUM,0)),$P(^(0),U,1)=X Q
30 .S DIC("DR")=".02////"_TYPE_";.03////"_CAT
31 .K DO,DD D FILE^DICN
32 .I Y=-1 D
33 ..W !!,"File #912.9, filing entry #"_$P(TEXT,U,1)
34 ..W !," for "_$P(TEXT,U,2)_" was unsuccessful."
35 .I +Y>0 D
36 ..W !!,"File #912.9, entry #"_$P(TEXT,U,1)
37 ..W !," for "_$P(TEXT,U,2)_" was successfully filed."
38 ;put inactivation dates in entries 23,24,25,26
39 S TEXT(23)="ABOVE $100 (GOV'T)"
40 S TEXT(24)="BELOW $100 (GOV'T)"
41 S TEXT(25)="ABOVE $100 (PERSONAL)"
42 S TEXT(26)="BELOW $100 (PERSONAL)"
43 F I=23,24,25,26 D
44 .I '$D(^ESP(912.9,I,1)) S DIE="^ESP(912.9,",DR="1////2971001",DA=I D ^DIE
45 .I $P($G(^ESP(912.9,I,1)),U,1)=2971001 D
46 ..W !!,"File #912.9, entry #"_I
47 ..W !," for "_TEXT(I)_" inactivated"
48 ..W !," effective October 1, 1997."
49 .I $P($G(^ESP(912.9,I,1)),U,1)'=2971001 D
50 ..W !!,"File #912.9, entry #"_I
51 ..W !," for "_TEXT(I)
52 ..W !," has not been properly inactivated."
53 Q
54 ;
55FILE2 ;update file #915
56 N I
57 K ^TMP($J,"WP"),^TMP($J,"ERR")
58 I $P($G(^ESP(915,55,0)),U,1)'="THEFT-GOVERNMENT PROPERTY" D
59 .W !!,"File #915, entry #55"
60 .W !," ...not updated."
61 .W !," Field #.01'=THEFT-GOVERNMENT PROPERTY"
62 I $P($G(^ESP(915,55,0)),U,1)="THEFT-GOVERNMENT PROPERTY" D
63 .F J=1:1:13 S ^TMP($J,"WP",J)=$P($T(UP55+J),";;",2)
64 .D WP^DIE(915,"55,",10,,"^TMP($J,""WP"")","^TMP($J,""ERR"")")
65 .I $D(^TMP($J,"ERR")) D
66 ..W !!,"File #915, entry #55 - THEFT-GOVERNMENT PROPERTY"
67 ..W !," ...not updated."
68 ..W !," "_^TMP($J,"ERR","DIERR",1,"TEXT",1)
69 .I '$D(^TMP($J,"ERR")) D
70 ..W !!,"File #915, entry #55 - THEFT-GOVERNMENT PROPERTY"
71 ..W !," ...successfully updated."
72 K ^TMP($J,"WP"),^TMP($J,"ERR")
73 I $P($G(^ESP(915,56,0)),U,1)'="THEFT-PERSONAL PROPERTY" D
74 .W !!,"File #915, entry #56"
75 .W !," ...not updated."
76 .W !," Field #.01'=THEFT-PERSONAL PROPERTY"
77 I $P($G(^ESP(915,56,0)),U,1)="THEFT-PERSONAL PROPERTY" D
78 .F J=1:1:14 S ^TMP($J,"WP",J)=$P($T(UP56+J),";;",2)
79 .D WP^DIE(915,"56,",10,,"^TMP($J,""WP"")","^TMP($J,""ERR"")")
80 .I $D(^TMP($J,"ERR")) D
81 ..W !!,"File #915, entry #56 - THEFT-PERSONAL PROPERTY"
82 ..W !," ...not updated."
83 ..W !," "_^TMP($J,"ERR","DIERR",1,"TEXT",1)
84 .I '$D(^TMP($J,"ERR")) D
85 ..W !!,"File #915, entry #56 - THEFT-PERSONAL PROPERTY"
86 ..W !," ...successfully updated."
87 K ^TMP($J,"WP"),^TMP($J,"ERR")
88 Q
89 ;
90CONVERT ;convert file #912 data
91 ;for any offense occurring after midnight 9-30-97;
92 ;convert any subtype 24 or 26 automatically;
93 ;convert any aubtype 23 or 25 only if it's the only subtype and the dollar amount
94 ;of property loss is known;
95 ;all other cases of subtype 23 or 25 require user intervention.
96 N ESDTBEG,ESDTREC,ESIEN,ESSUBT,ESN,ESNN,ESMONEY,ESCNVDT,ESCREAT,ESPURGE,X1,X2
97 D NOW^%DTC S Y=$E(%,1,12),ESCNVDT=$$FMTE^XLFDT(Y,"5"),(ESCREAT,X1)=$P(%,".",1),X2=90 D C^%DTC S ESPURGE=X
98 ;create the zero node for the temp storage global
99 S ^XTMP("ESP",0)=ESPURGE_"^"_ESCREAT_"^temporary storage for ES*1*22"
100 ;sort thru "C" xref; check field #.03
101 S (ESDTBEG,ESDTREC)=2970930.235959
102 F S ESDTREC=$O(^ESP(912,"C",ESDTREC)) Q:ESDTREC="" S ESIEN=$O(^(ESDTREC,0)) I ESIEN D
103 .Q:'$D(^ESP(912,ESIEN)) Q:$P(^ESP(912,ESIEN,0),"^",3)'>ESDTBEG
104 .S ESN=0
105 .F S ESN=$O(^ESP(912,ESIEN,10,ESN)) Q:+ESN=0 D
106 ..S ESMONEY=0,ESNN=0 F S ESNN=$O(^ESP(912,ESIEN,90,ESNN)) Q:+ESNN=0 S ESMONEY=ESMONEY+$P(^(ESNN,0),U,3)
107 ..;subtype=23,24,25,26 only
108 ..S ESSUBT=$P(^ESP(912,ESIEN,10,ESN,0),U,3) Q:(ESSUBT<23)!(ESSUBT>26) D
109 ...;automatically update any below $100 subtypes
110 ...I ESSUBT=24 S $P(^ESP(912,ESIEN,10,ESN,0),U,3)=40,^XTMP("ESP","CONV",ESIEN,ESN)=ESSUBT_"^40^.5^"_ESCNVDT Q
111 ...I ESSUBT=26 S $P(^ESP(912,ESIEN,10,ESN,0),U,3)=42,^XTMP("ESP","CONV",ESIEN,ESN)=ESSUBT_"^42^.5^"_ESCNVDT Q
112 ...;above $100 subtypes are still to be processed;
113 ...;if there is only one classification node and the property loss is known, then convert subtype
114 ...I ESN=1,+$O(^ESP(912,ESIEN,10,ESN))=0 D Q
115 ....I ESMONEY>0,ESMONEY<1001 D Q
116 .....I ESSUBT=23 S $P(^ESP(912,ESIEN,10,ESN,0),U,3)=40,^XTMP("ESP","CONV",ESIEN,ESN)=ESSUBT_"^40^.5^"_ESCNVDT Q
117 .....I ESSUBT=25 S $P(^ESP(912,ESIEN,10,ESN,0),U,3)=42,^XTMP("ESP","CONV",ESIEN,ESN)=ESSUBT_"^42^.5^"_ESCNVDT Q
118 ....I ESMONEY>1000 D Q
119 .....I ESSUBT=23 S $P(^ESP(912,ESIEN,10,ESN,0),U,3)=39,^XTMP("ESP","CONV",ESIEN,ESN)=ESSUBT_"^39^.5^"_ESCNVDT Q
120 .....I ESSUBT=25 S $P(^ESP(912,ESIEN,10,ESN,0),U,3)=41,^XTMP("ESP","CONV",ESIEN,ESN)=ESSUBT_"^41^.5^"_ESCNVDT Q
121 ....;if still not processed, then this subtype conversion requires user intervention
122 ....S ^XTMP("ESP","USER",ESIEN,ESN)=ESSUBT_"^"_ESMONEY
123 ...;if esn'=1 or esn=1 but multiple
124 ...S ^XTMP("ESP","USER",ESIEN,ESN)=ESSUBT_"^"_ESMONEY
125 Q
126 ;
127NEWREC ;new file entries for file #912.9
128 ;;39^ABOVE $1000 (GOV'T)^46^11
129 ;;40^BELOW $1000 (GOV'T)^46^11
130 ;;41^ABOVE $1000 (PERSONAL)^47^11
131 ;;42^BELOW $1000 (PERSONAL)^47^11
132 ;
133UP55 ;update record #55 in file #915
134 ;;Whoever embezzles, steals, purloins, or knowingly converts to his use
135 ;;or the use of another, or without authority, sells, conveys or
136 ;;disposes of any record, voucher, money, or thing of value of the
137 ;;United States or of any department or agency thereof, or any property
138 ;;made or being made under contract for the United States or any
139 ;;department or agency thereof, or Whoever receives, conceals or retains
140 ;;the same with intent to convert it to his use or gain, knowing it to
141 ;;have been embezzled, stolen, purloined or converted---Shall be fined
142 ;;not more than $10,000 or imprisoned not more than ten years, or both;
143 ;;but if the value of such property does not exceed the sum of $1000, he
144 ;;shall be fined not more than $1,000 or imprisoned not more than one
145 ;;year, or both. The word "value" means face, par or market value, or
146 ;;cost price, either wholesale or retail; whichever is greater.
147 ;
148UP56 ;update record #56 in file #915
149 ;;Whoever, within the special maritime and territorial jurisdiction
150 ;;of the United States, takes and carries away, with intent to steal
151 ;;or purloin, any personal property of another, shall be punished as
152 ;;follows: If the property taken is of a value exceeding $1000, or is
153 ;;taken from the person of another, by a fine of not more than $5,000,
154 ;;or imprisonment for not more than five years, or both; in all other
155 ;;cases by a fine of not more than $1,000 or by imprisonment not
156 ;;more than one year, or both. If the property stolen consists of any
157 ;;evidence of debt, or other written instrument, the amount of money
158 ;;due thereon, or secured to be paid thereby and remaining unsatisfied,
159 ;;or which in any contingency might be collected thereon, or the value
160 ;;of the property the title to which is shown thereby, or the sum
161 ;;which might be recovered in the absence thereof, shall be the value
162 ;;of the property stolen.
163 ;
Note: See TracBrowser for help on using the repository browser.