| 1 | GMRCITPI ;SLC/JFR - SET TEST PATIENT ICN'S ;10/2/02 12:10
|
|---|
| 2 | ;;3.0;CONSULT/REQUEST TRACKING;**22,28**;DEC 27, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine invokes IA #'s 3552, 3553
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | ; WARNING: due to complications that may occur with the VA MPI, this
|
|---|
| 8 | ; routine should never be executed in a production VistA
|
|---|
| 9 | ; environment.
|
|---|
| 10 | ;
|
|---|
| 11 | EN ;set test patient ICN's based on SSN
|
|---|
| 12 | I '$$ENVOK Q ;don't continue if environment isn't right
|
|---|
| 13 | N DIR,X,Y,DIRUT,DIROUT,DUOUT,DTOUT,GMRCPT,VA,VAHOW,VAROOT,DFN,OK
|
|---|
| 14 | W !!
|
|---|
| 15 | S DIR(0)="PAO^2:EMQZ",DIR("A")="Select shared patient: "
|
|---|
| 16 | D ^DIR I $D(DIRUT) Q
|
|---|
| 17 | S DFN=+Y
|
|---|
| 18 | S VAROOT="GMRCPT",VAHOW=1 D DEM^VADPT
|
|---|
| 19 | I '$$PATOK($P(GMRCPT("SS"),U)) G EN
|
|---|
| 20 | W !!,"Trying to set test patient ICN..."
|
|---|
| 21 | S OK=$$SETICN^MPIF001(DFN,(9_+GMRCPT("SS")),$E(GMRCPT("SS"),3,8))
|
|---|
| 22 | I 'OK W !!,"Unable to set ICN for this patient. Try again or select another patient." Q
|
|---|
| 23 | W !!," Done.",!
|
|---|
| 24 | G EN
|
|---|
| 25 | Q
|
|---|
| 26 | ENVOK() ;check and quit if this could be a production environment
|
|---|
| 27 | ; checks PROCESSING ID (#.03) of file 869.3 to see if training
|
|---|
| 28 | N GMRCPID
|
|---|
| 29 | S GMRCPID=$P($$PARAM^HLCS2,U,3) ; new API to call
|
|---|
| 30 | I '$L(GMRCPID) D Q 0
|
|---|
| 31 | . W !!,"Unable to continue! VistA HL7 is not configured."
|
|---|
| 32 | . W !,"Check the HL COMMUNICATION SERVER PARAMETERS file to be sure this is "
|
|---|
| 33 | . W !,"configured as a test environment."
|
|---|
| 34 | I GMRCPID="P" D Q 0
|
|---|
| 35 | . W !!,$C(7),"This appears to be a production system!",!!
|
|---|
| 36 | . W "This option is only for use in training environments!",!
|
|---|
| 37 | . W !,"If this is indeed a training environment, Check the HL COMMUNICATION "
|
|---|
| 38 | . W !,"SERVER PARAMETERS file to be sure this is configured as a test environment."
|
|---|
| 39 | . W !,"Then access this option again."
|
|---|
| 40 | Q 1
|
|---|
| 41 | ;
|
|---|
| 42 | PATOK(GMRCSSN) ;make sure patient is only one with the SSN passed in
|
|---|
| 43 | ; Input:
|
|---|
| 44 | ; GMRCSSN = ssn of patient in question
|
|---|
| 45 | ;
|
|---|
| 46 | ; Output:
|
|---|
| 47 | ; 1 = patient has a unique SSN and can be assigned a pseudo-ICN
|
|---|
| 48 | ; 0 = already a patient on file with the SSN
|
|---|
| 49 | N GMRCPT,ICN,OK
|
|---|
| 50 | I $E(GMRCSSN,1,5)="00000" D Q 0
|
|---|
| 51 | . W !,"Patients having a SSN with 5 leading zeros cannot be used for inter-facility",!,"consult testing. Edit the SSN or choose a different patient."
|
|---|
| 52 | I GMRCSSN["P" D Q 0
|
|---|
| 53 | . W !!,"This patient has a pseudo-SSN. A pseudo-ICN cannot be assigned. Edit the SSN",!,"or choose a different patient.",!
|
|---|
| 54 | S GMRCPT=$$FIND1^DIC(2,"","X",GMRCSSN,"SSN")
|
|---|
| 55 | I GMRCPT'>0 D Q 0
|
|---|
| 56 | . W !,"There is more than one patient on file with the SSN of this patient. ",!,"A pseudo-ICN cannot be assigned. Edit the SSN or choose different patient."
|
|---|
| 57 | S ICN=$$GETICN^MPIF001(GMRCPT)
|
|---|
| 58 | I $L(ICN),+ICN=(9_GMRCSSN) D Q 0
|
|---|
| 59 | . W !!,"Test patient ICN already set using current SSN.",!
|
|---|
| 60 | I $L(ICN),'$$IFLOCAL^MPIF001(GMRCPT) D Q OK
|
|---|
| 61 | . S OK=1
|
|---|
| 62 | . W !!,"This patient appears to have a national ICN on file.",!
|
|---|
| 63 | . N DIR,X,Y,DTOUT,DIRUT,DUOUT
|
|---|
| 64 | . S DIR(0)="YA",DIR("A")="Are you sure you want to overwrite this ICN? "
|
|---|
| 65 | . D ^DIR
|
|---|
| 66 | . I Y'>0 S OK=0
|
|---|
| 67 | Q 1
|
|---|
