GMRCITPI ;SLC/JFR - SET TEST PATIENT ICN'S ;10/2/02 12:10
;;3.0;CONSULT/REQUEST TRACKING;**22,28**;DEC 27, 1997
;
; This routine invokes IA #'s 3552, 3553
;
;
; WARNING: due to complications that may occur with the VA MPI, this
; routine should never be executed in a production VistA
; environment.
;
EN ;set test patient ICN's based on SSN
I '$$ENVOK Q ;don't continue if environment isn't right
N DIR,X,Y,DIRUT,DIROUT,DUOUT,DTOUT,GMRCPT,VA,VAHOW,VAROOT,DFN,OK
W !!
S DIR(0)="PAO^2:EMQZ",DIR("A")="Select shared patient: "
D ^DIR I $D(DIRUT) Q
S DFN=+Y
S VAROOT="GMRCPT",VAHOW=1 D DEM^VADPT
I '$$PATOK($P(GMRCPT("SS"),U)) G EN
W !!,"Trying to set test patient ICN..."
S OK=$$SETICN^MPIF001(DFN,(9_+GMRCPT("SS")),$E(GMRCPT("SS"),3,8))
I 'OK W !!,"Unable to set ICN for this patient. Try again or select another patient." Q
W !!," Done.",!
G EN
Q
ENVOK() ;check and quit if this could be a production environment
; checks PROCESSING ID (#.03) of file 869.3 to see if training
N GMRCPID
S GMRCPID=$P($$PARAM^HLCS2,U,3) ; new API to call
I '$L(GMRCPID) D Q 0
. W !!,"Unable to continue! VistA HL7 is not configured."
. W !,"Check the HL COMMUNICATION SERVER PARAMETERS file to be sure this is "
. W !,"configured as a test environment."
I GMRCPID="P" D Q 0
. W !!,$C(7),"This appears to be a production system!",!!
. W "This option is only for use in training environments!",!
. W !,"If this is indeed a training environment, Check the HL COMMUNICATION "
. W !,"SERVER PARAMETERS file to be sure this is configured as a test environment."
. W !,"Then access this option again."
Q 1
;
PATOK(GMRCSSN) ;make sure patient is only one with the SSN passed in
; Input:
; GMRCSSN = ssn of patient in question
;
; Output:
; 1 = patient has a unique SSN and can be assigned a pseudo-ICN
; 0 = already a patient on file with the SSN
N GMRCPT,ICN,OK
I $E(GMRCSSN,1,5)="00000" D Q 0
. 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."
I GMRCSSN["P" D Q 0
. W !!,"This patient has a pseudo-SSN. A pseudo-ICN cannot be assigned. Edit the SSN",!,"or choose a different patient.",!
S GMRCPT=$$FIND1^DIC(2,"","X",GMRCSSN,"SSN")
I GMRCPT'>0 D Q 0
. 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."
S ICN=$$GETICN^MPIF001(GMRCPT)
I $L(ICN),+ICN=(9_GMRCSSN) D Q 0
. W !!,"Test patient ICN already set using current SSN.",!
I $L(ICN),'$$IFLOCAL^MPIF001(GMRCPT) D Q OK
. S OK=1
. W !!,"This patient appears to have a national ICN on file.",!
. N DIR,X,Y,DTOUT,DIRUT,DUOUT
. S DIR(0)="YA",DIR("A")="Are you sure you want to overwrite this ICN? "
. D ^DIR
. I Y'>0 S OK=0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCITPI 2920 printed Apr 09, 2024@20:51 Page 2
GMRCITPI ;SLC/JFR - SET TEST PATIENT ICN'S ;10/2/02 12:10
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,28**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #'s 3552, 3553
+4 ;
+5 ;
+6 ; WARNING: due to complications that may occur with the VA MPI, this
+7 ; routine should never be executed in a production VistA
+8 ; environment.
+9 ;
EN ;set test patient ICN's based on SSN
+1 ;don't continue if environment isn't right
IF '$$ENVOK
QUIT
+2 NEW DIR,X,Y,DIRUT,DIROUT,DUOUT,DTOUT,GMRCPT,VA,VAHOW,VAROOT,DFN,OK
+3 WRITE !!
+4 SET DIR(0)="PAO^2:EMQZ"
SET DIR("A")="Select shared patient: "
+5 DO ^DIR
IF $DATA(DIRUT)
QUIT
+6 SET DFN=+Y
+7 SET VAROOT="GMRCPT"
SET VAHOW=1
DO DEM^VADPT
+8 IF '$$PATOK($PIECE(GMRCPT("SS"),U))
GOTO EN
+9 WRITE !!,"Trying to set test patient ICN..."
+10 SET OK=$$SETICN^MPIF001(DFN,(9_+GMRCPT("SS")),$EXTRACT(GMRCPT("SS"),3,8))
+11 IF 'OK
WRITE !!,"Unable to set ICN for this patient. Try again or select another patient."
QUIT
+12 WRITE !!," Done.",!
+13 GOTO EN
+14 QUIT
ENVOK() ;check and quit if this could be a production environment
+1 ; checks PROCESSING ID (#.03) of file 869.3 to see if training
+2 NEW GMRCPID
+3 ; new API to call
SET GMRCPID=$PIECE($$PARAM^HLCS2,U,3)
+4 IF '$LENGTH(GMRCPID)
Begin DoDot:1
+5 WRITE !!,"Unable to continue! VistA HL7 is not configured."
+6 WRITE !,"Check the HL COMMUNICATION SERVER PARAMETERS file to be sure this is "
+7 WRITE !,"configured as a test environment."
End DoDot:1
QUIT 0
+8 IF GMRCPID="P"
Begin DoDot:1
+9 WRITE !!,$CHAR(7),"This appears to be a production system!",!!
+10 WRITE "This option is only for use in training environments!",!
+11 WRITE !,"If this is indeed a training environment, Check the HL COMMUNICATION "
+12 WRITE !,"SERVER PARAMETERS file to be sure this is configured as a test environment."
+13 WRITE !,"Then access this option again."
End DoDot:1
QUIT 0
+14 QUIT 1
+15 ;
PATOK(GMRCSSN) ;make sure patient is only one with the SSN passed in
+1 ; Input:
+2 ; GMRCSSN = ssn of patient in question
+3 ;
+4 ; Output:
+5 ; 1 = patient has a unique SSN and can be assigned a pseudo-ICN
+6 ; 0 = already a patient on file with the SSN
+7 NEW GMRCPT,ICN,OK
+8 IF $EXTRACT(GMRCSSN,1,5)="00000"
Begin DoDot:1
+9 WRITE !,"Patients having a SSN with 5 leading zeros cannot be used for inter-facility",!,"consult testing. Edit the SSN or choose a different patient."
End DoDot:1
QUIT 0
+10 IF GMRCSSN["P"
Begin DoDot:1
+11 WRITE !!,"This patient has a pseudo-SSN. A pseudo-ICN cannot be assigned. Edit the SSN",!,"or choose a different patient.",!
End DoDot:1
QUIT 0
+12 SET GMRCPT=$$FIND1^DIC(2,"","X",GMRCSSN,"SSN")
+13 IF GMRCPT'>0
Begin DoDot:1
+14 WRITE !,"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."
End DoDot:1
QUIT 0
+15 SET ICN=$$GETICN^MPIF001(GMRCPT)
+16 IF $LENGTH(ICN)
IF +ICN=(9_GMRCSSN)
Begin DoDot:1
+17 WRITE !!,"Test patient ICN already set using current SSN.",!
End DoDot:1
QUIT 0
+18 IF $LENGTH(ICN)
IF '$$IFLOCAL^MPIF001(GMRCPT)
Begin DoDot:1
+19 SET OK=1
+20 WRITE !!,"This patient appears to have a national ICN on file.",!
+21 NEW DIR,X,Y,DTOUT,DIRUT,DUOUT
+22 SET DIR(0)="YA"
SET DIR("A")="Are you sure you want to overwrite this ICN? "
+23 DO ^DIR
+24 IF Y'>0
SET OK=0
End DoDot:1
QUIT OK
+25 QUIT 1
