Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (15 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/POLICE_AND_SECURITY-ES/ESPQNC.m

    r613 r623  
    1 ESPQNC  ;Albany/VAD - QUICK NAME CHECK ; 11/27/07 2:15pm
    2         ;;1.0;POLICE & SECURITY;**2,18,21,29,45**;Mar 31, 1994;Build 1
    3 START   W !! S DIC("A")="Select Name: ",DIC="^ESP(910,",DIC(0)="AEMQZ" D ^DIC I Y<0 G EXIT
    4         S ESPNAM=+Y W !?5,"SEX: ",$P(^ESP(910,ESPNAM,0),"^",8),?20,"RACE: ",$S($D(^DIC(10,+$P(^(0),"^",9),0)):$P(^DIC(10,+$P(^ESP(910,ESPNAM,0),"^",9),0),"^",1),1:""),!!
    5         S ESPN=0,ESPCNT=0,ESPSTP=0,ESPLAST=0
    6         S ESPL=9
    7 REG     ;
    8         S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(910.2,"D",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
    9         .  S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". " S REG0=^ESP(910.2,ESPI,0),ESPREG(ESPN)=ESPI W $P("VEHICLE^BICYCLE^WEAPON^PET^GOLF","^",$P(REG0,"^",4))," REGISTRATION ",$P(REG0,"^",1)," ",$P($G(^ESP(910.7,+$P(REG0,"^",2),0)),U)
    10         .  I ESPCNT>ESPL S ESPR=ESPN D SELX
    11         S ESPR=$G(ESPN)
    12         G:ESPSTP START
    13 VIO     ;
    14         S ESPJ=0 F ESPJ1=1:1 S ESPJ=$O(^ESP(914,"E",ESPNAM,ESPJ)) Q:ESPJ=""!ESPSTP  D
    15         .  S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". VIOLATION-" S VIO0=^ESP(914,ESPJ,0),ESPVIO(ESPN)=ESPJ S Y=$P(^(0),U,2) X ^DD("DD") W "  ",Y W " ",$P($G(^ESP(915,$P(^ESP(914,ESPJ,0),U,4),0)),U)
    16         .  I ESPCNT>ESPL S ESPV=ESPN D SELX
    17         S ESPV=$G(ESPN)
    18         G:ESPSTP START
    19 OFF     ;
    20         S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(912,"D",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
    21         .  S OFF0=^ESP(912,ESPI,0) I $P(^(5),U,2),$P(^(5),U,5),'$P(^(5),U,4) S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". OFFENSE COMPLAINANT- " S (ESPDTR,X)=$P(^ESP(912,ESPI,0),U,2) W $$CONV^ESPUOR(X) D CL S ESPOFF(ESPN)=ESPI
    22         .  I ESPCNT>ESPL S ESPO=ESPN D SELX
    23         G:ESPSTP START
    24         S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(912,"E",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
    25         .  I $P(^ESP(912,ESPI,5),U,2),$P(^(5),U,5),'$P(^(5),U,4) S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". OFFENSE VICTIM- " S (ESPDTR,X)=$P(^ESP(912,ESPI,0),U,2) W $$CONV^ESPUOR(X) D CL S ESPOFF(ESPN)=ESPI
    26         .  I ESPCNT>ESPL S ESPO=ESPN D SELX
    27         G:ESPSTP START
    28         S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(912,"G",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
    29         .  I $P(^ESP(912,ESPI,5),U,2),$P(^(5),U,5),'$P(^(5),U,4) S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". OFFENSE OFFENDER- " S (ESPDTR,X)=$P(^ESP(912,ESPI,0),U,2) W $$CONV^ESPUOR(X) D CL S ESPOFF(ESPN)=ESPI
    30         .  I ESPCNT>ESPL S ESPO=ESPN D SELX
    31         G:ESPSTP START
    32         S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(912,"I",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
    33         .  I $P(^ESP(912,ESPI,5),U,2),$P(^(5),U,5),'$P(^(5),U,4) S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". OFFENSE WITNESS- " S (ESPDTR,X)=$P(^ESP(912,ESPI,0),U,2) W $$CONV^ESPUOR(X) D CL S ESPOFF(ESPN)=ESPI
    34         .  I ESPCNT>ESPL S ESPO=ESPN D SELX
    35         S ESPO=$G(ESPN)
    36         G:ESPSTP START
    37 WAR     ;
    38         S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(913,"B",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
    39         .  S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". " S WAR0=^ESP(913,ESPI,0),ESPWAR(ESPN)=ESPI W "WANT OR WARRANT " S Y=$P(WAR0,U) X ^DD("DD") W Y," ",$P(WAR0,U,6)
    40         .  I ESPCNT>ESPL S ESPW=ESPN D SELX
    41         S ESPW=$G(ESPN)
    42         G:ESPSTP START
    43 EVID    ;
    44         S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(910.8,"C",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
    45         . S EVI0=^ESP(910.8,ESPI,0) I '$P(^(0),U,4) S ESPN=ESPN+1,ESPEVI(ESPN)=ESPI,ESPCNT=ESPCNT+1 W !?5,ESPN,". EVIDENCE RECORD NUMBER ",$P(^(0),U)," ",$P($G(^ESP(910.8,ESPI,10)),U)
    46         . I ESPCNT>ESPL S ESPE=ESPN D SELX
    47         S ESPE=$G(ESPN)
    48         G:ESPSTP START
    49         S ESPN=$G(ESPN)+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". " W "MASTER NAME INDEX RECORD" S ESPLAST=1
    50         D SELX
    51         G START
    52         ;
    53 SELX    ;
    54         Q:ESPSTP  W ! S DIR(0)="NO^1:"_ESPN,DIR("A")="Select a number for viewing, ^ to exit"
    55         I 'ESPLAST S DIR("A")=DIR("A")_", <RETURN> for more"
    56         D ^DIR S ESPX=X W !
    57         I $D(DTOUT) S ESPSTP=1 Q
    58         I X["^" S ESPSTP=1 Q
    59         I X=""&'ESPLAST S ESPSTP=0,ESPCNT=0 Q
    60         I X=""&ESPLAST S ESPSTP=1 Q
    61         S ESPSTP=1
    62         ; ===================================================================
    63         ;S %ZIS="Q" D ^%ZIS I POP S ESPSTP=1 Q
    64         ;I '$D(IO("Q")) U IO D DISP D:IO'=IO(0) ^%ZISC Q
    65         ;S ZTRTN="DISP^ESPQNC",ZTSAVE("ESP*")="",ZTDESC="QUICK NAME CHECK" D ^%ZTLOAD,HOME^%ZIS
    66         ; -------------------------------------------------------------------
    67         ; The following lines replace the lines above.
    68         ; -------------------------------------------------------------------
    69         N ZTRTN,ZTSAVE,ZTDESC
    70         S ZTRTN="DISP^ESPQNC",ZTSAVE("ESP*")="",ZTDESC="QUICK NAME CHECK"
    71         W ! D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
    72         ; ===================================================================
    73         Q
    74         ;
    75 DISP    ;
    76         I ESPX<ESPR!(ESPX=ESPR) S DA=ESPREG(ESPX),DIC="^ESP(910.2," D EN^DIQ Q
    77         I ESPX>ESPR,ESPX<ESPV!(ESPX=ESPV) S ESPID=ESPVIO(ESPX) D START^ESPVNP Q
    78         I ESPX>ESPV,ESPX<ESPO!(ESPX=ESPO) S ESPID=ESPOFF(ESPX),ESPDTR=$P(^ESP(912,ESPID,0),U,2) D START^ESPORP Q
    79         I ESPX>ESPO,ESPX<ESPW!(ESPX=ESPW) S DA=ESPWAR(ESPX),DIC="^ESP(913," D EN^DIQ Q
    80         I ESPX>ESPW,ESPX<ESPE!(ESPX=ESPE) S DA=ESPEVI(ESPX),DIC="^ESP(910.8," D EN^DIQ Q
    81         I ESPX=ESPN S DA=ESPNAM,DIC="^ESP(910," D EN^DIQ Q
    82         ;
    83 EXIT    ;
    84         K %ZIS,DA,DIC,DIQ,DIR,DR,DTOUT,ESPDTR,ESPE,ESPEVI,ESPFN,ESPI,ESPI1,ESPID,ESPJ,ESPJ1,ESPN,ESPNAM,ESPO,ESPOFF,ESPR,ESPREG,ESPV,ESPVIO,ESPW,ESPWAR,ESPX,ESPZ,EVI0,OFF0,REG0,VIO0,WAR0,X,Y,ESPCNT,ESPSTP,ESPL,ESPLAST
    85         Q
    86         ;
    87 CL      ;PRINT CLASSIFICATION CODES, TYPES, AND SUBTYPES
    88         F ESPZ=0:0 S ESPZ=$O(^ESP(912,ESPI,10,ESPZ)) Q:ESPZ'>0  D
    89         .  S DIC="^ESP(912,"_ESPI_",10,",DA=ESPZ,DR=".01;.02;.03",DIQ(0)="E" D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J,912.01,DA,.01,"E"))
    90         .  W "  ",$G(^UTILITY("DIQ1",$J,912.01,DA,.01,"E"))
    91         .  I $G(^UTILITY("DIQ1",$J,912.01,DA,.02,"E"))]"" W "/",^("E")
    92         .  I $G(^UTILITY("DIQ1",$J,912.01,DA,.03,"E"))]"" W "/",^("E")
    93         .  K DIC,DR
    94         QUIT
     1ESPQNC ;Albany/VAD - QUICK NAME CHECK ;Nov 3, 1999
     2 ;;1.0;POLICE & SECURITY;**2,18,21,29**;Mar 31, 1994
     3START W !! S DIC("A")="Select Name: ",DIC="^ESP(910,",DIC(0)="AEMQZ" D ^DIC I Y<0 G EXIT
     4 S ESPNAM=+Y W !?5,"SEX: ",$P(^ESP(910,ESPNAM,0),"^",8),?20,"RACE: ",$S($D(^DIC(10,+$P(^(0),"^",9),0)):$P(^DIC(10,+$P(^ESP(910,ESPNAM,0),"^",9),0),"^",1),1:""),!!
     5 S ESPN=0,ESPCNT=0,ESPSTP=0,ESPLAST=0
     6 S ESPL=9
     7REG ;
     8 S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(910.2,"D",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
     9 .  S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". " S REG0=^ESP(910.2,ESPI,0),ESPREG(ESPN)=ESPI W $P("VEHICLE^BICYCLE^WEAPON^PET^GOLF","^",$P(REG0,"^",4))," REGISTRATION ",$P(REG0,"^",1)," ",$P($G(^ESP(910.7,+$P(REG0,"^",2),0)),U)
     10 .  I ESPCNT>ESPL S ESPR=ESPN D SELX
     11 S ESPR=$G(ESPN)
     12 G:ESPSTP START
     13VIO ;
     14 S ESPJ=0 F ESPJ1=1:1 S ESPJ=$O(^ESP(914,"E",ESPNAM,ESPJ)) Q:ESPJ=""!ESPSTP  D
     15 .  S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". VIOLATION-" S VIO0=^ESP(914,ESPJ,0),ESPVIO(ESPN)=ESPJ S Y=$P(^(0),U,2) X ^DD("DD") W "  ",Y W " ",$P($G(^ESP(915,$P(^ESP(914,ESPJ,0),U,4),0)),U)
     16 .  I ESPCNT>ESPL S ESPV=ESPN D SELX
     17 S ESPV=$G(ESPN)
     18 G:ESPSTP START
     19OFF ;
     20 S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(912,"D",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
     21 .  S OFF0=^ESP(912,ESPI,0) I $P(^(5),U,2),$P(^(5),U,5),'$P(^(5),U,4) S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". OFFENSE COMPLAINANT- " S (ESPDTR,X)=$P(^ESP(912,ESPI,0),U,2) W $$CONV^ESPUOR(X) D CL S ESPOFF(ESPN)=ESPI
     22 .  I ESPCNT>ESPL S ESPO=ESPN D SELX
     23 G:ESPSTP START
     24 S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(912,"E",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
     25 .  I $P(^ESP(912,ESPI,5),U,2),$P(^(5),U,5),'$P(^(5),U,4) S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". OFFENSE VICTIM- " S (ESPDTR,X)=$P(^ESP(912,ESPI,0),U,2) W $$CONV^ESPUOR(X) D CL S ESPOFF(ESPN)=ESPI
     26 .  I ESPCNT>ESPL S ESPO=ESPN D SELX
     27 G:ESPSTP START
     28 S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(912,"G",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
     29 .  I $P(^ESP(912,ESPI,5),U,2),$P(^(5),U,5),'$P(^(5),U,4) S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". OFFENSE OFFENDER- " S (ESPDTR,X)=$P(^ESP(912,ESPI,0),U,2) W $$CONV^ESPUOR(X) D CL S ESPOFF(ESPN)=ESPI
     30 .  I ESPCNT>ESPL S ESPO=ESPN D SELX
     31 G:ESPSTP START
     32 S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(912,"I",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
     33 .  I $P(^ESP(912,ESPI,5),U,2),$P(^(5),U,5),'$P(^(5),U,4) S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". OFFENSE WITNESS- " S (ESPDTR,X)=$P(^ESP(912,ESPI,0),U,2) W $$CONV^ESPUOR(X) D CL S ESPOFF(ESPN)=ESPI
     34 .  I ESPCNT>ESPL S ESPO=ESPN D SELX
     35 S ESPO=$G(ESPN)
     36 G:ESPSTP START
     37WAR ;
     38 S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(913,"B",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
     39 .  S ESPN=ESPN+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". " S WAR0=^ESP(913,ESPI,0),ESPWAR(ESPN)=ESPI W "WANT OR WARRANT " S Y=$P(WAR0,U) X ^DD("DD") W Y," ",$P(WAR0,U,6)
     40 .  I ESPCNT>ESPL S ESPW=ESPN D SELX
     41 S ESPW=$G(ESPN)
     42 G:ESPSTP START
     43EVID ;
     44 S ESPI=0 F ESPI1=1:1 S ESPI=$O(^ESP(910.8,"C",ESPNAM,ESPI)) Q:ESPI=""!ESPSTP  D
     45 . S EVI0=^ESP(910.8,ESPI,0) I '$P(^(0),U,4) S ESPN=ESPN+1,ESPEVI(ESPN)=ESPI,ESPCNT=ESPCNT+1 W !?5,ESPN,". EVIDENCE RECORD NUMBER ",$P(^(0),U)," ",$P($G(^ESP(910.8,ESPI,10)),U)
     46 . I ESPCNT>ESPL S ESPE=ESPN D SELX
     47 S ESPE=$G(ESPN)
     48 G:ESPSTP START
     49 S ESPN=$G(ESPN)+1,ESPCNT=ESPCNT+1 W !?5,ESPN,". " W "MASTER NAME INDEX RECORD" S ESPLAST=1
     50 D SELX
     51 G START
     52 ;
     53SELX ;
     54 Q:ESPSTP  W ! S DIR(0)="NO^1:"_ESPN,DIR("A")="Select a number for viewing, ^ to exit"
     55 I 'ESPLAST S DIR("A")=DIR("A")_", <RETURN> for more"
     56 D ^DIR S ESPX=X W !
     57 I $D(DTOUT) S ESPSTP=1 Q
     58 I X="^" S ESPSTP=1 Q
     59 I X=""&'ESPLAST S ESPSTP=0,ESPCNT=0 Q
     60 I X=""&ESPLAST S ESPSTP=1 Q
     61 S ESPSTP=1
     62 ; ===================================================================
     63 ;S %ZIS="Q" D ^%ZIS I POP S ESPSTP=1 Q
     64 ;I '$D(IO("Q")) U IO D DISP D:IO'=IO(0) ^%ZISC Q
     65 ;S ZTRTN="DISP^ESPQNC",ZTSAVE("ESP*")="",ZTDESC="QUICK NAME CHECK" D ^%ZTLOAD,HOME^%ZIS
     66 ; -------------------------------------------------------------------
     67 ; The following lines replace the lines above.
     68 ; -------------------------------------------------------------------
     69 N ZTRTN,ZTSAVE,ZTDESC
     70 S ZTRTN="DISP^ESPQNC",ZTSAVE("ESP*")="",ZTDESC="QUICK NAME CHECK"
     71 W ! D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
     72 ; ===================================================================
     73 Q
     74 ;
     75DISP ;
     76 I ESPX<ESPR!(ESPX=ESPR) S DA=ESPREG(ESPX),DIC="^ESP(910.2," D EN^DIQ Q
     77 I ESPX>ESPR,ESPX<ESPV!(ESPX=ESPV) S ESPID=ESPVIO(ESPX) D START^ESPVNP Q
     78 I ESPX>ESPV,ESPX<ESPO!(ESPX=ESPO) S ESPID=ESPOFF(ESPX),ESPDTR=$P(^ESP(912,ESPID,0),U,2) D START^ESPORP Q
     79 I ESPX>ESPO,ESPX<ESPW!(ESPX=ESPW) S DA=ESPWAR(ESPX),DIC="^ESP(913," D EN^DIQ Q
     80 I ESPX>ESPW,ESPX<ESPE!(ESPX=ESPE) S DA=ESPEVI(ESPX),DIC="^ESP(910.8," D EN^DIQ Q
     81 I ESPX=ESPN S DA=ESPNAM,DIC="^ESP(910," D EN^DIQ Q
     82 ;
     83EXIT ;
     84 K %ZIS,DA,DIC,DIQ,DIR,DR,DTOUT,ESPDTR,ESPE,ESPEVI,ESPFN,ESPI,ESPI1,ESPID,ESPJ,ESPJ1,ESPN,ESPNAM,ESPO,ESPOFF,ESPR,ESPREG,ESPV,ESPVIO,ESPW,ESPWAR,ESPX,ESPZ,EVI0,OFF0,REG0,VIO0,WAR0,X,Y,ESPCNT,ESPSTP,ESPL,ESPLAST
     85 Q
     86 ;
     87CL ;PRINT CLASSIFICATION CODES, TYPES, AND SUBTYPES
     88 F ESPZ=0:0 S ESPZ=$O(^ESP(912,ESPI,10,ESPZ)) Q:ESPZ'>0  D
     89 .  S DIC="^ESP(912,"_ESPI_",10,",DA=ESPZ,DR=".01;.02;.03",DIQ(0)="E" D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J,912.01,DA,.01,"E"))
     90 .  W "  ",$G(^UTILITY("DIQ1",$J,912.01,DA,.01,"E"))
     91 .  I $G(^UTILITY("DIQ1",$J,912.01,DA,.02,"E"))]"" W "/",^("E")
     92 .  I $G(^UTILITY("DIQ1",$J,912.01,DA,.03,"E"))]"" W "/",^("E")
     93 .  K DIC,DR
     94 QUIT
Note: See TracChangeset for help on using the changeset viewer.