ESP122P2 ;ALB/JAP; POST-INSTALL FOR ES*1*22 cont.;3/98
;;1.0;POLICE & SECURITY;**22**;Mar 31, 1994
;
MANUAL ;user update of file #912 entries (manual)
N X,Y,DIC,DTOUT,DUOUT,ESPOUT,LN,ESIEN,ESN
S $P(LN,"=",80)=""
;subtype conversion array - these are the only changes allowed
S ESPCNV("ABOVE $100 (GOV'T)",1)="39^ABOVE $1000 (GOV'T)"
S ESPCNV("ABOVE $100 (GOV'T)",2)="40^BELOW $1000 (GOV'T)"
S ESPCNV("ABOVE $100 (PERSONAL)",1)="41^ABOVE $1000 (PERSONAL)"
S ESPCNV("ABOVE $100 (PERSONAL)",2)="42^BELOW $1000 (PERSONAL)"
S ESPCNV("ABOVE $1000 (GOV'T)",1)="40^BELOW $1000 (GOV'T)"
S ESPCNV("BELOW $1000 (GOV'T)",1)="39^ABOVE $1000 (GOV'T)"
S ESPCNV("ABOVE $1000 (PERSONAL)",1)="42^BELOW $1000 (PERSONAL)"
S ESPCNV("BELOW $1000 (PERSONAL)",1)="41^ABOVE $1000 (PERSONAL)"
;subtype iens
S ESPOLD("ABOVE $100 (GOV'T)")=23
S ESPOLD("ABOVE $100 (PERSONAL)")=25
S ESPOLD("ABOVE $1000 (GOV'T)")=39
S ESPOLD("BELOW $1000 (GOV'T)")=40
S ESPOLD("ABOVE $1000 (PERSONAL)")=41
S ESPOLD("BELOW $1000 (PERSONAL)")=42
;select a file #912 record eligible for conversion/change
F S ESPOUT=0 D Q:$D(DTOUT)!($D(DUOUT))!(ESPOUT)
.S DIC="^ESP(912,",DIC(0)="AEMNQ"
.S DIC("S")="I $P(^ESP(912,Y,0),U,3)>2970930.235959"
.D ^DIC
.I X="" S ESPOUT=1 Q
.Q:Y=-1
.S ESIEN=+Y
.I ('$D(^XTMP("ESP","CONV",ESIEN)))&('$D(^XTMP("ESP","USER",ESIEN))) D Q
..W !,"That record doesn't need to be converted. Try again...",!! K ESIEN
.D DISPLAY Q:ESPOUT
.D UPDATE
K ESPCNV,ESPOLD
Q
;
DISPLAY ;display file #912 record data
D HOME^%ZIS
W @IOF
S ESPDTR=$P($G(^ESP(912,ESIEN,0)),U,2) Q:ESPDTR=""
W !?20,"Patch ES*1*22 Conversion Utility"
W !,"File #912 ien: ",ESIEN
W ?45,"UOR# ",$E(ESPDTR,2,3),"-",$E(ESPDTR,4,5),"-",$E(ESPDTR,6,7),"-",$TR($E($P(ESPDTR,".",2)_"ZZZZ",1,4),"Z",0)
K ^UTILITY("DIQ1",$J)
S DIC="^ESP(912,",DA=ESIEN,DR=".02;.03;.04;.06;.08;5.02;5.05;5.06;6.01;6.02",DIQ(0)="E" D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J,912,DA))
W !,"DATE/TIME RECEIVED: ",$G(^UTILITY("DIQ1",$J,912,DA,.02,"E"))
W !,"DATE/TIME OF OFFENSE: ",$G(^UTILITY("DIQ1",$J,912,DA,.03,"E"))
W !,"LOCATION: ",$G(^UTILITY("DIQ1",$J,912,DA,.04,"E"))
W !,"INVESTIGATING OFFICER: ",$G(^UTILITY("DIQ1",$J,912,DA,.06,"E"))
W !,"CASE STATUS: ",$G(^UTILITY("DIQ1",$J,912,DA,.08,"E"))
W ?45,"COMPLETED FLAG: ",$G(^UTILITY("DIQ1",$J,912,DA,5.02,"E"))
S FLAG=$G(^UTILITY("DIQ1",$J,912,DA,5.05,"E")) D
.Q:FLAG="" Q:FLAG["NONE"
.W !,"DELETED/REOPENED FLAG: ",FLAG
.I $E(FLAG,1)="D" W ?45,"DATE/TIME: ",$G(^UTILITY("DIQ1",$J,912,DA,5.06,"E"))
.I ($E(FLAG,1)="R")&($D(^UTILITY("DIQ1",$J,912,DA,6.02,"E"))) W ?45,"DATE/TIME: ",^UTILITY("DIQ1",$J,912,DA,6.02,"E"),!?45,"PREVIOUS ID#: ",$G(^UTILITY("DIQ1",$J,912,DA,6.01,"E"))
W !,"LOST/STOLEN PROPERTY:"
I $D(^ESP(912,ESIEN,90)) D
.S ESL=0 F S ESL=$O(^ESP(912,ESIEN,90,ESL)) Q:ESL="" D
..S DIC="^ESP(912,"_ESIEN_",90,",DA=ESL,DR=".01;.03",DIQ(0)="E" D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J,912.1,DA))
..W !?5,$G(^UTILITY("DIQ1",$J,912.1,DA,.01,"E"))
..W ?45,"LOSS: $",$G(^UTILITY("DIQ1",$J,912.1,DA,.03,"E"))
I '$D(^ESP(912,ESIEN,90)) D
.W !?5,"(No information available.)"
K ESN S ESN=0 F S ESN=$O(^ESP(912,ESIEN,10,ESN)) Q:ESN="" D
.S (ESOLD,ESUSER,ESCNVDT)=0,ESOLDNM=""
.S ESOLD=$P($G(^XTMP("ESP","CONV",ESIEN,ESN)),U,1)
.I ESOLD S ESUSER=$P($G(^XTMP("ESP","CONV",ESIEN,ESN)),U,3),ESCNVDT=$P($G(^XTMP("ESP","CONV",ESIEN,ESN)),U,4)
.S DIC="^ESP(912,"_ESIEN_",10,",DA=ESN,DR=".01;.02;.03",DIQ(0)="E" D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J,912.01,DA,.01,"E"))
.I $D(^XTMP("ESP","CONV",ESIEN,ESN)) S ESN(ESN)=$G(^UTILITY("DIQ1",$J,912.01,DA,.03,"E"))
.I $D(^XTMP("ESP","USER",ESIEN,ESN)) S ESN(ESN)=$G(^UTILITY("DIQ1",$J,912.01,DA,.03,"E"))
.I ESOLD D
..S NUM="("_ESN_") ",NUML=$L(NUM)
..W !,NUM_"Classification: ",!?5,$G(^UTILITY("DIQ1",$J,912.01,DA,.01,"E"))
..I $G(^UTILITY("DIQ1",$J,912.01,DA,.02,"E"))]"" W "/",^("E")
..I $G(^UTILITY("DIQ1",$J,912.01,DA,.03,"E"))]"" W "/",^("E")
..I ESUSER W !,?NUML,"Converted by: ",$E($P($G(^VA(200,ESUSER,0)),U,1),1,20),?45,"Date/time: ",ESCNVDT
.I 'ESOLD D
..S NUM="("_ESN_") ",NUML=$L(NUM)
..W !,NUM_"Classification: ",!?5,$G(^UTILITY("DIQ1",$J,912.01,DA,.01,"E"))
..I $G(^UTILITY("DIQ1",$J,912.01,DA,.02,"E"))]"" W "/",^("E")
..I $G(^UTILITY("DIQ1",$J,912.01,DA,.03,"E"))]"" W "/",^("E")
W !,LN,!
Q
;
UPDATE ;allow user to update subtype of subrecord
;variable esien=record, array esn=subrecords which may be converted
N DIR,DTOUT,DUOUT,DIRUT,X,Y,SUBTYPE,NUM,NEWSUB,OLDSUB,ESPOUT,ESPPREV
D NOW^%DTC S Y=$E(%,1,12),ESCNVDT=$$FMTE^XLFDT(Y,"5")
W !!,"You may modify the following sub-record(s) -- ",!
W !?5,"Sub-record #",?25,"Current Subtype"
S JJ=0,DIR(0)="LA^",DIR("A")="Select sub-record #: "
F S JJ=$O(ESN(JJ)) Q:JJ="" D
.S DIR(0)=DIR(0)_","_JJ_","
.W !,?8,JJ,?25,ESN(JJ)
W ! D ^DIR W ! K DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:(X["^")!(Y["^")
I '$D(ESN(+Y)) G UPDATE
S ESN=+Y,SUBTYPE=ESN(+Y),OLDSUB=ESPOLD(SUBTYPE)
;if more than 1 possible subtype to change to
S (ESPOUT,NUM,NEWSUB)=0
I $D(ESPCNV(SUBTYPE,2)) F D Q:(NUM)!(ESPOUT)
.W !!?5,"The subrecord selected may be converted"
.W !?5," to one of the following:",!
.W !!?10,"(a) "_$P(ESPCNV(SUBTYPE,1),U,2)
.W !?10,"(b) "_$P(ESPCNV(SUBTYPE,2),U,2)
.S DIR(0)="SA^A:"_$P(ESPCNV(SUBTYPE,1),U,2)_";B:"_$P(ESPCNV(SUBTYPE,2),U,2)
.S DIR("A")="Select (a) or (b): "
.W !?5 D ^DIR W ! K DIR
.I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S ESPOUT=1
.I (X["^")!(Y["^") S ESPOUT=1
.I Y="A" S NUM=1
.I Y="B" S NUM=2
Q:ESPOUT
;if only 1 possible subtype to change to
I '$D(ESPCNV(SUBTYPE,2)) S NUM=1
S NEWSUB=$P(ESPCNV(SUBTYPE,NUM),U,1)
;update the subrecord
S $P(^ESP(912,ESIEN,10,ESN,0),U,3)=NEWSUB
;keep previous conversion data, if any
S ESPPREV=1+$O(^XTMP("ESP","PREV",ESIEN,ESN,""),-1)
I $D(^XTMP("ESP","CONV",ESIEN,ESN)) S ^XTMP("ESP","PREV",ESIEN,ESN,ESPPREV)=^XTMP("ESP","CONV",ESIEN,ESN)
;store the conversion data
S ^XTMP("ESP","CONV",ESIEN,ESN)=OLDSUB_"^"_NEWSUB_"^"_DUZ_"^"_ESCNVDT
;delete from unreviewed, if necessary
K ^XTMP("ESP","USER",ESIEN,ESN)
W !!,"...done.",!
K X,Y,DIR S DIR(0)="E" D ^DIR K DIR W !!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESP122P2 6231 printed Dec 13, 2024@02:29:30 Page 2
ESP122P2 ;ALB/JAP; POST-INSTALL FOR ES*1*22 cont.;3/98
+1 ;;1.0;POLICE & SECURITY;**22**;Mar 31, 1994
+2 ;
MANUAL ;user update of file #912 entries (manual)
+1 NEW X,Y,DIC,DTOUT,DUOUT,ESPOUT,LN,ESIEN,ESN
+2 SET $PIECE(LN,"=",80)=""
+3 ;subtype conversion array - these are the only changes allowed
+4 SET ESPCNV("ABOVE $100 (GOV'T)",1)="39^ABOVE $1000 (GOV'T)"
+5 SET ESPCNV("ABOVE $100 (GOV'T)",2)="40^BELOW $1000 (GOV'T)"
+6 SET ESPCNV("ABOVE $100 (PERSONAL)",1)="41^ABOVE $1000 (PERSONAL)"
+7 SET ESPCNV("ABOVE $100 (PERSONAL)",2)="42^BELOW $1000 (PERSONAL)"
+8 SET ESPCNV("ABOVE $1000 (GOV'T)",1)="40^BELOW $1000 (GOV'T)"
+9 SET ESPCNV("BELOW $1000 (GOV'T)",1)="39^ABOVE $1000 (GOV'T)"
+10 SET ESPCNV("ABOVE $1000 (PERSONAL)",1)="42^BELOW $1000 (PERSONAL)"
+11 SET ESPCNV("BELOW $1000 (PERSONAL)",1)="41^ABOVE $1000 (PERSONAL)"
+12 ;subtype iens
+13 SET ESPOLD("ABOVE $100 (GOV'T)")=23
+14 SET ESPOLD("ABOVE $100 (PERSONAL)")=25
+15 SET ESPOLD("ABOVE $1000 (GOV'T)")=39
+16 SET ESPOLD("BELOW $1000 (GOV'T)")=40
+17 SET ESPOLD("ABOVE $1000 (PERSONAL)")=41
+18 SET ESPOLD("BELOW $1000 (PERSONAL)")=42
+19 ;select a file #912 record eligible for conversion/change
+20 FOR
SET ESPOUT=0
Begin DoDot:1
+21 SET DIC="^ESP(912,"
SET DIC(0)="AEMNQ"
+22 SET DIC("S")="I $P(^ESP(912,Y,0),U,3)>2970930.235959"
+23 DO ^DIC
+24 IF X=""
SET ESPOUT=1
QUIT
+25 if Y=-1
QUIT
+26 SET ESIEN=+Y
+27 IF ('$DATA(^XTMP("ESP","CONV",ESIEN)))&('$DATA(^XTMP("ESP","USER",ESIEN)))
Begin DoDot:2
+28 WRITE !,"That record doesn't need to be converted. Try again...",!!
KILL ESIEN
End DoDot:2
QUIT
+29 DO DISPLAY
if ESPOUT
QUIT
+30 DO UPDATE
End DoDot:1
if $DATA(DTOUT)!($DATA(DUOUT))!(ESPOUT)
QUIT
+31 KILL ESPCNV,ESPOLD
+32 QUIT
+33 ;
DISPLAY ;display file #912 record data
+1 DO HOME^%ZIS
+2 WRITE @IOF
+3 SET ESPDTR=$PIECE($GET(^ESP(912,ESIEN,0)),U,2)
if ESPDTR=""
QUIT
+4 WRITE !?20,"Patch ES*1*22 Conversion Utility"
+5 WRITE !,"File #912 ien: ",ESIEN
+6 WRITE ?45,"UOR# ",$EXTRACT(ESPDTR,2,3),"-",$EXTRACT(ESPDTR,4,5),"-",$EXTRACT(ESPDTR,6,7),"-",$TRANSLATE($EXTRACT($PIECE(ESPDTR,".",2)_"ZZZZ",1,4),"Z",0)
+7 KILL ^UTILITY("DIQ1",$JOB)
+8 SET DIC="^ESP(912,"
SET DA=ESIEN
SET DR=".02;.03;.04;.06;.08;5.02;5.05;5.06;6.01;6.02"
SET DIQ(0)="E"
DO EN^DIQ1
if '$DATA(^UTILITY("DIQ1",$JOB,912,DA))
QUIT
+9 WRITE !,"DATE/TIME RECEIVED: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.02,"E"))
+10 WRITE !,"DATE/TIME OF OFFENSE: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.03,"E"))
+11 WRITE !,"LOCATION: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.04,"E"))
+12 WRITE !,"INVESTIGATING OFFICER: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.06,"E"))
+13 WRITE !,"CASE STATUS: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.08,"E"))
+14 WRITE ?45,"COMPLETED FLAG: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,5.02,"E"))
+15 SET FLAG=$GET(^UTILITY("DIQ1",$JOB,912,DA,5.05,"E"))
Begin DoDot:1
+16 if FLAG=""
QUIT
if FLAG["NONE"
QUIT
+17 WRITE !,"DELETED/REOPENED FLAG: ",FLAG
+18 IF $EXTRACT(FLAG,1)="D"
WRITE ?45,"DATE/TIME: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,5.06,"E"))
+19 IF ($EXTRACT(FLAG,1)="R")&($DATA(^UTILITY("DIQ1",$JOB,912,DA,6.02,"E")))
WRITE ?45,"DATE/TIME: ",^UTILITY("DIQ1",$JOB,912,DA,6.02,"E"),!?45,"PREVIOUS ID#: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,6.01,"E"))
End DoDot:1
+20 WRITE !,"LOST/STOLEN PROPERTY:"
+21 IF $DATA(^ESP(912,ESIEN,90))
Begin DoDot:1
+22 SET ESL=0
FOR
SET ESL=$ORDER(^ESP(912,ESIEN,90,ESL))
if ESL=""
QUIT
Begin DoDot:2
+23 SET DIC="^ESP(912,"_ESIEN_",90,"
SET DA=ESL
SET DR=".01;.03"
SET DIQ(0)="E"
DO EN^DIQ1
if '$DATA(^UTILITY("DIQ1",$JOB,912.1,DA))
QUIT
+24 WRITE !?5,$GET(^UTILITY("DIQ1",$JOB,912.1,DA,.01,"E"))
+25 WRITE ?45,"LOSS: $",$GET(^UTILITY("DIQ1",$JOB,912.1,DA,.03,"E"))
End DoDot:2
End DoDot:1
+26 IF '$DATA(^ESP(912,ESIEN,90))
Begin DoDot:1
+27 WRITE !?5,"(No information available.)"
End DoDot:1
+28 KILL ESN
SET ESN=0
FOR
SET ESN=$ORDER(^ESP(912,ESIEN,10,ESN))
if ESN=""
QUIT
Begin DoDot:1
+29 SET (ESOLD,ESUSER,ESCNVDT)=0
SET ESOLDNM=""
+30 SET ESOLD=$PIECE($GET(^XTMP("ESP","CONV",ESIEN,ESN)),U,1)
+31 IF ESOLD
SET ESUSER=$PIECE($GET(^XTMP("ESP","CONV",ESIEN,ESN)),U,3)
SET ESCNVDT=$PIECE($GET(^XTMP("ESP","CONV",ESIEN,ESN)),U,4)
+32 SET DIC="^ESP(912,"_ESIEN_",10,"
SET DA=ESN
SET DR=".01;.02;.03"
SET DIQ(0)="E"
DO EN^DIQ1
if '$DATA(^UTILITY("DIQ1",$JOB,912.01,DA,.01,"E"))
QUIT
+33 IF $DATA(^XTMP("ESP","CONV",ESIEN,ESN))
SET ESN(ESN)=$GET(^UTILITY("DIQ1",$JOB,912.01,DA,.03,"E"))
+34 IF $DATA(^XTMP("ESP","USER",ESIEN,ESN))
SET ESN(ESN)=$GET(^UTILITY("DIQ1",$JOB,912.01,DA,.03,"E"))
+35 IF ESOLD
Begin DoDot:2
+36 SET NUM="("_ESN_") "
SET NUML=$LENGTH(NUM)
+37 WRITE !,NUM_"Classification: ",!?5,$GET(^UTILITY("DIQ1",$JOB,912.01,DA,.01,"E"))
+38 IF $GET(^UTILITY("DIQ1",$JOB,912.01,DA,.02,"E"))]""
WRITE "/",^("E")
+39 IF $GET(^UTILITY("DIQ1",$JOB,912.01,DA,.03,"E"))]""
WRITE "/",^("E")
+40 IF ESUSER
WRITE !,?NUML,"Converted by: ",$EXTRACT($PIECE($GET(^VA(200,ESUSER,0)),U,1),1,20),?45,"Date/time: ",ESCNVDT
End DoDot:2
+41 IF 'ESOLD
Begin DoDot:2
+42 SET NUM="("_ESN_") "
SET NUML=$LENGTH(NUM)
+43 WRITE !,NUM_"Classification: ",!?5,$GET(^UTILITY("DIQ1",$JOB,912.01,DA,.01,"E"))
+44 IF $GET(^UTILITY("DIQ1",$JOB,912.01,DA,.02,"E"))]""
WRITE "/",^("E")
+45 IF $GET(^UTILITY("DIQ1",$JOB,912.01,DA,.03,"E"))]""
WRITE "/",^("E")
End DoDot:2
End DoDot:1
+46 WRITE !,LN,!
+47 QUIT
+48 ;
UPDATE ;allow user to update subtype of subrecord
+1 ;variable esien=record, array esn=subrecords which may be converted
+2 NEW DIR,DTOUT,DUOUT,DIRUT,X,Y,SUBTYPE,NUM,NEWSUB,OLDSUB,ESPOUT,ESPPREV
+3 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
SET ESCNVDT=$$FMTE^XLFDT(Y,"5")
+4 WRITE !!,"You may modify the following sub-record(s) -- ",!
+5 WRITE !?5,"Sub-record #",?25,"Current Subtype"
+6 SET JJ=0
SET DIR(0)="LA^"
SET DIR("A")="Select sub-record #: "
+7 FOR
SET JJ=$ORDER(ESN(JJ))
if JJ=""
QUIT
Begin DoDot:1
+8 SET DIR(0)=DIR(0)_","_JJ_","
+9 WRITE !,?8,JJ,?25,ESN(JJ)
End DoDot:1
+10 WRITE !
DO ^DIR
WRITE !
KILL DIR
+11 if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+12 if (X["^")!(Y["^")
QUIT
+13 IF '$DATA(ESN(+Y))
GOTO UPDATE
+14 SET ESN=+Y
SET SUBTYPE=ESN(+Y)
SET OLDSUB=ESPOLD(SUBTYPE)
+15 ;if more than 1 possible subtype to change to
+16 SET (ESPOUT,NUM,NEWSUB)=0
+17 IF $DATA(ESPCNV(SUBTYPE,2))
FOR
Begin DoDot:1
+18 WRITE !!?5,"The subrecord selected may be converted"
+19 WRITE !?5," to one of the following:",!
+20 WRITE !!?10,"(a) "_$PIECE(ESPCNV(SUBTYPE,1),U,2)
+21 WRITE !?10,"(b) "_$PIECE(ESPCNV(SUBTYPE,2),U,2)
+22 SET DIR(0)="SA^A:"_$PIECE(ESPCNV(SUBTYPE,1),U,2)_";B:"_$PIECE(ESPCNV(SUBTYPE,2),U,2)
+23 SET DIR("A")="Select (a) or (b): "
+24 WRITE !?5
DO ^DIR
WRITE !
KILL DIR
+25 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
SET ESPOUT=1
+26 IF (X["^")!(Y["^")
SET ESPOUT=1
+27 IF Y="A"
SET NUM=1
+28 IF Y="B"
SET NUM=2
End DoDot:1
if (NUM)!(ESPOUT)
QUIT
+29 if ESPOUT
QUIT
+30 ;if only 1 possible subtype to change to
+31 IF '$DATA(ESPCNV(SUBTYPE,2))
SET NUM=1
+32 SET NEWSUB=$PIECE(ESPCNV(SUBTYPE,NUM),U,1)
+33 ;update the subrecord
+34 SET $PIECE(^ESP(912,ESIEN,10,ESN,0),U,3)=NEWSUB
+35 ;keep previous conversion data, if any
+36 SET ESPPREV=1+$ORDER(^XTMP("ESP","PREV",ESIEN,ESN,""),-1)
+37 IF $DATA(^XTMP("ESP","CONV",ESIEN,ESN))
SET ^XTMP("ESP","PREV",ESIEN,ESN,ESPPREV)=^XTMP("ESP","CONV",ESIEN,ESN)
+38 ;store the conversion data
+39 SET ^XTMP("ESP","CONV",ESIEN,ESN)=OLDSUB_"^"_NEWSUB_"^"_DUZ_"^"_ESCNVDT
+40 ;delete from unreviewed, if necessary
+41 KILL ^XTMP("ESP","USER",ESIEN,ESN)
+42 WRITE !!,"...done.",!
+43 KILL X,Y,DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !!
+44 QUIT
