- ESPMNI0 ;DALISC/CKA - INPUT MASTER NAME DATA;6/93
- ;;1.0;POLICE & SECURITY;**25**;Mar 31, 1994
- EN ;Q ;CALLED FROM ESPMNI
- NAME S DIR(0)="910,.01",DIR("B")=ESPX D ^DIR K DIR I $D(DIRUT) K ESPFN G NOU
- S ESPD(.01)=Y
- SSN S ESPX=.02 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.02)=Y S:Y?9N ESPD(.02,"P")=$E(Y,1,3)_"-"_$E(Y,4,5)_"-"_$E(Y,6,9)
- I ESPD(.02)']"" G DOB
- DOB S ESPX=.03 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.03)=Y
- I Y D DD^%DT S ESPD(.03,"P")=Y
- SEX S ESPX=.08 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.08)=$P(Y,U)
- RACE S ESPX=.09 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.09)=$P(Y,U,1),ESPD(.09,"P")=$P(Y,U,2)
- HGT S ESPX=3.01 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(3.01)=Y
- WGT S ESPX=3.02 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(3.02)=Y
- HAIR S ESPX=3.03 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(3.03)=$P(Y,U),ESPD(3.03,"P")=$P(Y,U,2)
- EYE S ESPX=3.04 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(3.04)=$P(Y,U),ESPD(3.04,"P")=$P(Y,U,2)
- SKIN S ESPX=3.05 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(3.05)=$P(Y,U),ESPD(3.05,"P")=$P(Y,U,2)
- SCAR S ESPX=3.06 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(3.06)=Y
- DL S ESPX=.1 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.1)=Y
- I ESPD(.1)="" G CAT
- ST S ESPX=.11 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.11)=$P(Y,U,1),ESPD(.11,"P")=$P(Y,U,2)
- CAT S ESPX=.04 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.04)=$P(Y,U),ESPD(.04,"P")=$S(Y="P":"PATIENT",Y="V":"VISITOR",Y="E":"EMPLOYEE",Y="O":"OUTSIDER",Y="PO":"POLICE OFFICER",1:"")
- I ESPD(.04)'="E"&(ESPD(.04)'="PO") G AG
- SER S ESPX=.05 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.05)=$P(Y,U,1),ESPD(.05,"P")=$P(Y,U,2)
- ID S ESPX=.07 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.07)=Y
- G WPH
- AG S ESPX=.06 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(.06)=Y
- I ESPD(.06)="" G WPH
- WA1 S ESPX=2.01 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(2.01)=Y
- WA2 S ESPX=2.02 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(2.02)=Y
- WCI S ESPX=2.03 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(2.03)=Y
- WST S ESPX=2.04 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(2.04)=$P(Y,U,1),ESPD(2.04,"P")=$P(Y,U,2)
- WZIP S ESPX=2.05 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(2.05)=Y
- WPH S ESPX=2.06 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(2.06)=Y
- HA1 S ESPX=1.01 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(1.01)=Y
- HA2 S ESPX=1.02 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(1.02)=Y
- HCI S ESPX=1.03 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(1.03)=Y
- HST S ESPX=1.04 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(1.04)=$P(Y,U,1),ESPD(1.04,"P")=$P(Y,U,2)
- HZIP S ESPX=1.05 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(1.05)=Y
- HPH S ESPX=1.06 D RD G:$D(DUOUT)!($D(DTOUT)) NOU S ESPD(1.06)=Y
- QUIT
- EXIT K %X,%Y,D,DA,DIC,DIR,DIRUT,DIWF,DIWL,DIWR,ESPAKA,ESPD,ESPDOB,ESPJ,ESPNO,ESPX,I,IEN,X,Y,^TMP($J,"MNI")
- QUIT
- NOU W !!,$C(7),?20,"NO UPDATING HAS OCCURRED!!!",!! K ESPAKA,ESPD,^TMP($J,"MNI") G EXIT
- RD K DIR("B"),DA S DIR(0)="910,"_ESPX D ^DIR I $S(($L(X)>1&($E(X)=U)):1,($L(X)>1&(X[U)):1,1:0) D NO K X,Y G RD
- K DIR
- Q
- NO W $C(7),!!?5,"NO ^___ ALLOWED!",!! Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPMNI0 2986 printed Apr 23, 2025@18:44:17 Page 2
- ESPMNI0 ;DALISC/CKA - INPUT MASTER NAME DATA;6/93
- +1 ;;1.0;POLICE & SECURITY;**25**;Mar 31, 1994
- EN ;Q ;CALLED FROM ESPMNI
- NAME SET DIR(0)="910,.01"
- SET DIR("B")=ESPX
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- KILL ESPFN
- GOTO NOU
- +1 SET ESPD(.01)=Y
- SSN SET ESPX=.02
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.02)=Y
- if Y?9N
- SET ESPD(.02,"P")=$EXTRACT(Y,1,3)_"-"_$EXTRACT(Y,4,5)_"-"_$EXTRACT(Y,6,9)
- +1 IF ESPD(.02)']""
- GOTO DOB
- DOB SET ESPX=.03
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.03)=Y
- +1 IF Y
- DO DD^%DT
- SET ESPD(.03,"P")=Y
- SEX SET ESPX=.08
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.08)=$PIECE(Y,U)
- RACE SET ESPX=.09
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.09)=$PIECE(Y,U,1)
- SET ESPD(.09,"P")=$PIECE(Y,U,2)
- HGT SET ESPX=3.01
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(3.01)=Y
- WGT SET ESPX=3.02
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(3.02)=Y
- HAIR SET ESPX=3.03
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(3.03)=$PIECE(Y,U)
- SET ESPD(3.03,"P")=$PIECE(Y,U,2)
- EYE SET ESPX=3.04
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(3.04)=$PIECE(Y,U)
- SET ESPD(3.04,"P")=$PIECE(Y,U,2)
- SKIN SET ESPX=3.05
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(3.05)=$PIECE(Y,U)
- SET ESPD(3.05,"P")=$PIECE(Y,U,2)
- SCAR SET ESPX=3.06
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(3.06)=Y
- DL SET ESPX=.1
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.1)=Y
- +1 IF ESPD(.1)=""
- GOTO CAT
- ST SET ESPX=.11
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.11)=$PIECE(Y,U,1)
- SET ESPD(.11,"P")=$PIECE(Y,U,2)
- CAT SET ESPX=.04
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.04)=$PIECE(Y,U)
- SET ESPD(.04,"P")=$SELECT(Y="P":"PATIENT",Y="V":"VISITOR",Y="E":"EMPLOYEE",Y="O":"OUTSIDER",Y="PO":"POLICE OFFICER",1:"")
- +1 IF ESPD(.04)'="E"&(ESPD(.04)'="PO")
- GOTO AG
- SER SET ESPX=.05
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.05)=$PIECE(Y,U,1)
- SET ESPD(.05,"P")=$PIECE(Y,U,2)
- ID SET ESPX=.07
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.07)=Y
- +1 GOTO WPH
- AG SET ESPX=.06
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(.06)=Y
- +1 IF ESPD(.06)=""
- GOTO WPH
- WA1 SET ESPX=2.01
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(2.01)=Y
- WA2 SET ESPX=2.02
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(2.02)=Y
- WCI SET ESPX=2.03
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(2.03)=Y
- WST SET ESPX=2.04
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(2.04)=$PIECE(Y,U,1)
- SET ESPD(2.04,"P")=$PIECE(Y,U,2)
- WZIP SET ESPX=2.05
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(2.05)=Y
- WPH SET ESPX=2.06
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(2.06)=Y
- HA1 SET ESPX=1.01
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(1.01)=Y
- HA2 SET ESPX=1.02
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(1.02)=Y
- HCI SET ESPX=1.03
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(1.03)=Y
- HST SET ESPX=1.04
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(1.04)=$PIECE(Y,U,1)
- SET ESPD(1.04,"P")=$PIECE(Y,U,2)
- HZIP SET ESPX=1.05
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(1.05)=Y
- HPH SET ESPX=1.06
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO NOU
- SET ESPD(1.06)=Y
- +1 QUIT
- EXIT KILL %X,%Y,D,DA,DIC,DIR,DIRUT,DIWF,DIWL,DIWR,ESPAKA,ESPD,ESPDOB,ESPJ,ESPNO,ESPX,I,IEN,X,Y,^TMP($JOB,"MNI")
- +1 QUIT
- NOU WRITE !!,$CHAR(7),?20,"NO UPDATING HAS OCCURRED!!!",!!
- KILL ESPAKA,ESPD,^TMP($JOB,"MNI")
- GOTO EXIT
- RD KILL DIR("B"),DA
- SET DIR(0)="910,"_ESPX
- DO ^DIR
- IF $SELECT(($LENGTH(X)>1&($EXTRACT(X)=U)):1,($LENGTH(X)>1&(X[U)):1,1:0)
- DO NO
- KILL X,Y
- GOTO RD
- +1 KILL DIR
- +2 QUIT
- NO WRITE $CHAR(7),!!?5,"NO ^___ ALLOWED!",!!
- QUIT
