- DG10 ;ALB/MRL,DAK,AEG,PHH,TMK,ASMR/JD-LOAD/EDIT PATIENT DATA ; 09/30/15 @ 08:34
- ;;5.3;Registration;**32,109,139,149,182,326,513,425,574,642,658,773,864,921,993,1040**;Aug 13, 1993;Build 15
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;Done for eHMP project: DG*5.3*921
- ;Added logic to trigger unsolicited updates for demographics that are not otherwise triggered
- ;by the TRIGGER x-ref. New code: Tags T, T59, and T60 and any references to those tags thereof.
- START ;
- D LO^DGUTL
- I $G(DGPRFLG)=1,$G(DGPLOC)=1 D G Q:$G(DGRPOUT),A1
- .; D EN^DGRPD,REG^IVMCQ($G(DFN))
- . D EN^DGRPD
- . Q:$G(DGRPOUT)
- . D REG^IVMCQ($G(DFN))
- . D HINQ
- ;
- ; DG*5.3*993; Remove the DLAYGO variable and the "L" from DIC(0) since adding records to the PATIENT file is not allowed in DG LOAD PATIENT DATA
- A ;W !! K VET,DIE,DIC,CARD S DIC=2,DLAYGO=2,DIC(0)="ALEQM" K DIC("S") D ^DIC G Q:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) K DLAYGO
- ; DG*5.3*1040 - NEW variable DGTMOT and initialize to 0 to track timeout in address and DGADDRE to track the return value of $$ADD^DGADDUTL
- N DGADDRE,DGTMOT S DGTMOT=0,DGADDRE=""
- W !! K VET,DIE,DIC,CARD S DIC=2,DIC(0)="AEQM" K DIC("S") D ^DIC G Q:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) K DLAYGO
- ;DG*5.3*921 Invoke eHMP demographic change checking
- I DGNEW']"" D T59(DFN,"BEFORE") ;Get a snapshot of the demographics before changes
- N Y D PAUSE I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
- ;
- ;MPI QUERY
- ;check to see if CIRN PD/MPI is installed
- N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP
- K MPIFRTN
- D MPIQ^MPIFAPI(DFN)
- K MPIFRTN
- ;
- N DGNOIVMUPD
- S DGNOIVMUPD=1 ; Set flag to prevent MT Event Driver from updating converted IVM test
- I +$G(DGNEW) D
- . ; query CMOR for Patient Record Flag Assignments if NEW patient and
- . ; display results
- . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
- . I $$EN^DGPFMPI(DFN)
- ;
- SKIP ;
- ;DG*5.3*921 Invoke eHMP demographic change checking (via D T)
- S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) K DGRPOUT D T G A
- D HINQ,REG^IVMCQ($G(DFN)) G A1
- ;
- HINQ ;
- S Y=$S($D(^DG(43,1,0)):^(0),1:0) I $P(Y,U,27) S X="DVBHQZ4" X ^%ZOSF("TEST") I $T D
- .N DGROUT
- .S DGROUT=X
- .I $G(DFN) D
- ..N X,Y,DGRP
- ..F X=.3,.32 S DGRP(X)=$G(^DPT(DFN,X))
- ..W !," Money Verified: " S Y=$P(DGRP(.3),"^",6) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
- ..W ?40," Service Verified: " S Y=$P(DGRP(.32),"^",2) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
- .D @("EN^"_DGROUT) K Y Q ;from dgdem0
- Q
- ;
- ; SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management
- ; to bypass the embossing routines when calling load/edit from IEMM
- ;
- ; DG*5.3*1040 - If variable DGADDRE=-1, branch to RPOUT due to timeout; if DGRPOUT=1, branch to RPOUT as well
- A1 D G:$G(DGADDRE)=-1 RPOUT G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP G:+$G(DGRPOUT) RPOUT D MT(DFN),CP G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM) G Q:'$D(DA),EMBOS
- .W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data"
- .S %=1 D YN^DICN
- .I +$G(DGNEW) Q
- .S DGADDRE=$$ADD^DGADDUTL($G(DFN)) ; DG*5.3*1040 - Store the return value in DGADDRE
- ;
- H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing."
- G A1
- ;
- ; DG*5.3*1040 - Only do if there wasn't a timeout so branch to RPOUT
- CK S DGEDCN=1 G:+$G(DGRPOUT) RPOUT D ^DGRPC,MT(DFN),CP
- G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM)
- I $G(DGER)[55 K DIR S DIR(0)="Y",DIR("A")="Do you wish to return to Screen #9 to enter missing Income Data? " D ^DIR K DIR
- ;G:Y ^DGRP9
- ;
- EMBOS ;W ! D EMBOS^DGQEMA G A
- ;DG*5.3*921 Invoke eHMP demographic change checking
- D T
- G A
- ;
- ;
- ; DG*5.3*1040 - Clean variable DGTMOT
- Q K X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,DGTMOT,VET Q
- ;
- MT(DFN) ; Check if user requires a means test. Ask user if they want to proceedif
- ; one is required
- I '$D(SDIEMM) DO
- .N DGREQF,DIV
- .D EN^DGMTR
- .I DGREQF D EDT^DGMTU(DFN,DT):$P($$MTS^DGMTU(DFN),U,2)="R"
- .Q
- I $D(SDIEMM) DO
- .N DGMTI
- .S DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1)
- .I $P(DGMTI,U,4)="R" D I 1
- ..S DGMT0=$G(^DGMT(408.31,+DGMTI,0)),DGMTDT=$P(DGMT0,"^")
- ..I '$$OKTOCONT(DGMTDT) Q
- ..S DGMTI=+DGMTI,DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" D EN^DGMTSC
- .E D WARNING
- .Q
- Q
- ;
- WARNING ;
- ;prints a warning to the screen about means test
- ;
- W !!,"A means test for this encounter date was not found and may be required!"
- W !,"Further investigation will be needed."
- W !
- D PAUSE
- Q
- ;
- PAUSE ;
- N DIR
- S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR
- Q
- ;
- OKTOCONT(Y) ;
- ;
- N DIR
- W !!,"Patient Requires a means Test"
- X ^DD("DD")
- W !,"Primary Means Test Required from '",Y,"'",!
- ;
- I $D(SDIEMM),'$D(^XUSEC("SCENI MEANS TEST EDIT",DUZ)) DO G OKQ
- .W !,$C(7),"You do not have the appropriate IEMM Security Key. Contact your supervisor.",!
- .D PAUSE
- .S Y=0
- ;
- S DIR("A")="Do you wish to proceed with the means test at this time"
- S DIR("B")="YES"
- S DIR(0)="Y"
- D ^DIR
- OKQ Q $S(Y=1:1,1:0)
- ;
- CP ;If not (autoexempt or MTested) & no CP test this year then
- ;prompt for add/edit cp test
- N DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT
- G:'$P($G(^DG(43,1,0)),U,41) QTCP ;USE CP FLAG
- S DGIBDT=$S($D(DFN1):9999999-DFN1,1:DT)
- D EN^DGMTCOR
- I +$G(DGNOCOPF) S DGMTCOR=0
- I DGMTCOR D THRESH^DGMTCOU1(DGIBDT) D EDT^DGMTCOU(DFN,DT)
- K DGNOCOPF
- QTCP Q
- ;
- T ;
- ;DG*5.3*921- Check to ensure all demographic changes are passed to eHMP 10/2/15
- ;If we are editing demographics for an existing patient, get a snapshot after
- ;the changes and compare the before and after snapshots. If there are ANY changes
- ;invoke the unsolicited update protocol.
- I DGNEW']"" D
- .N DGFIELD,DGFILE,DGDA
- .D T59(DFN,"AFTER")
- .I $$T60("BEFORE","AFTER",.DGFIELD) S DGFILE=2,DGDA=DFN D:$L($T(DG^HMPEVNT)) DG^HMPEVNT
- Q
- ;
- T59(A,B) ;Get all the demographics that are supposed to trigger an unsolicited update
- ;DG*5.3*921
- ;A = DFN
- ;B = Return array
- N FLDS,INS
- S FLDS=".01;.02;.03;.05;.08;.09;.351;.361;.364;.111;.1112;.112;.113;.114;.115;.131;.132;.134;"
- S FLDS=FLDS_".211;.212;.213;.214;.216;.217;.218;.219;.301;.302;1901;.32102;.32103;.32201;.5295;"
- S FLDS=FLDS_".133;.1211;.1212;.1213;.1214;.1215;.1216;.331;.332;.333;.334;.335;.336;.337;"
- S FLDS=FLDS_".338;.339;.33011;.215;.21011;.3731;"
- D GETS^DIQ(2,A_",",FLDS,,B)
- Q
- ;
- T60(A,B,C) ;Compare the before and after arrays to see if any of the considerd demographics
- ;were changed
- ;DG*5.3*921
- ;A = "before" changes array
- ;B = "after" changes array
- ;Both A and B are of the form: A(2,DFN_",",Field#)=Field value. E.g. A(2,"3,",.114)="LOS ANGELES"
- ;C = the first field that was changed (e.g. .111 for street address line 1).
- ; This is an output parameter.
- ;Returns true (1) if any change is detected. Quits at the FIRST find.
- ; false (null) if there are no changes.
- N F,X,Y,Z
- S (C,F,Z)=""
- F S Z=$O(@A@(Z)) Q:$G(F)!(Z'=+Z) D
- .S Y=""
- .F S Y=$O(@A@(Z,Y)) Q:$G(F)!(Y']"") D
- ..S X=""
- ..F S X=$O(@A@(Z,Y,X)) Q:$G(F)!(X'=+X) D
- ...I @A@(Z,Y,X)'=$G(@B@(Z,Y,X)) S F=1,C=X Q
- Q F
- ; DG*5.3*1040 - Entry point to quit and go to next select patient prompt
- RPOUT ; Entry point if user timeout out
- S DGRPOUT=""
- G A
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG10 7261 printed Jan 18, 2025@03:35:46 Page 2
- DG10 ;ALB/MRL,DAK,AEG,PHH,TMK,ASMR/JD-LOAD/EDIT PATIENT DATA ; 09/30/15 @ 08:34
- +1 ;;5.3;Registration;**32,109,139,149,182,326,513,425,574,642,658,773,864,921,993,1040**;Aug 13, 1993;Build 15
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;Done for eHMP project: DG*5.3*921
- +5 ;Added logic to trigger unsolicited updates for demographics that are not otherwise triggered
- +6 ;by the TRIGGER x-ref. New code: Tags T, T59, and T60 and any references to those tags thereof.
- START ;
- +1 DO LO^DGUTL
- +2 IF $GET(DGPRFLG)=1
- IF $GET(DGPLOC)=1
- Begin DoDot:1
- +3 ; D EN^DGRPD,REG^IVMCQ($G(DFN))
- +4 DO EN^DGRPD
- +5 if $GET(DGRPOUT)
- QUIT
- +6 DO REG^IVMCQ($GET(DFN))
- +7 DO HINQ
- End DoDot:1
- if $GET(DGRPOUT)
- GOTO Q
- GOTO A1
- +8 ;
- +9 ; DG*5.3*993; Remove the DLAYGO variable and the "L" from DIC(0) since adding records to the PATIENT file is not allowed in DG LOAD PATIENT DATA
- A ;W !! K VET,DIE,DIC,CARD S DIC=2,DLAYGO=2,DIC(0)="ALEQM" K DIC("S") D ^DIC G Q:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) K DLAYGO
- +1 ; DG*5.3*1040 - NEW variable DGTMOT and initialize to 0 to track timeout in address and DGADDRE to track the return value of $$ADD^DGADDUTL
- +2 NEW DGADDRE,DGTMOT
- SET DGTMOT=0
- SET DGADDRE=""
- +3 WRITE !!
- KILL VET,DIE,DIC,CARD
- SET DIC=2
- SET DIC(0)="AEQM"
- KILL DIC("S")
- DO ^DIC
- if Y<0
- GOTO Q
- SET (DFN,DA)=+Y
- SET DGNEW=$PIECE(Y,"^",3)
- KILL DLAYGO
- +4 ;DG*5.3*921 Invoke eHMP demographic change checking
- +5 ;Get a snapshot of the demographics before changes
- IF DGNEW']""
- DO T59(DFN,"BEFORE")
- +6 NEW Y
- DO PAUSE
- IF DGNEW
- DO NEW^DGRP
- SET DA=DFN
- SET VET=$SELECT($DATA(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
- +7 ;
- +8 ;MPI QUERY
- +9 ;check to see if CIRN PD/MPI is installed
- +10 NEW X
- SET X="MPIFAPI"
- XECUTE ^%ZOSF("TEST")
- if '$TEST
- GOTO SKIP
- +11 KILL MPIFRTN
- +12 DO MPIQ^MPIFAPI(DFN)
- +13 KILL MPIFRTN
- +14 ;
- +15 NEW DGNOIVMUPD
- +16 ; Set flag to prevent MT Event Driver from updating converted IVM test
- SET DGNOIVMUPD=1
- +17 IF +$GET(DGNEW)
- Begin DoDot:1
- +18 ; query CMOR for Patient Record Flag Assignments if NEW patient and
- +19 ; display results
- +20 IF $$PRFQRY^DGPFAPI(DFN)
- DO DISPPRF^DGPFAPI(DFN)
- +21 IF $$EN^DGPFMPI(DFN)
- End DoDot:1
- +22 ;
- SKIP ;
- +1 ;DG*5.3*921 Invoke eHMP demographic change checking (via D T)
- +2 SET DGELVER=0
- DO EN^DGRPD
- IF $DATA(DGRPOUT)
- KILL DGRPOUT
- DO T
- GOTO A
- +3 DO HINQ
- DO REG^IVMCQ($GET(DFN))
- GOTO A1
- +4 ;
- HINQ ;
- +1 SET Y=$SELECT($DATA(^DG(43,1,0)):^(0),1:0)
- IF $PIECE(Y,U,27)
- SET X="DVBHQZ4"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- Begin DoDot:1
- +2 NEW DGROUT
- +3 SET DGROUT=X
- +4 IF $GET(DFN)
- Begin DoDot:2
- +5 NEW X,Y,DGRP
- +6 FOR X=.3,.32
- SET DGRP(X)=$GET(^DPT(DFN,X))
- +7 WRITE !," Money Verified: "
- SET Y=$PIECE(DGRP(.3),"^",6)
- if Y]""
- XECUTE ^DD("DD")
- WRITE $SELECT(Y]"":Y,1:"NOT VERIFIED")
- +8 WRITE ?40," Service Verified: "
- SET Y=$PIECE(DGRP(.32),"^",2)
- if Y]""
- XECUTE ^DD("DD")
- WRITE $SELECT(Y]"":Y,1:"NOT VERIFIED")
- End DoDot:2
- +9 ;from dgdem0
- DO @("EN^"_DGROUT)
- KILL Y
- QUIT
- End DoDot:1
- +10 QUIT
- +11 ;
- +12 ; SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management
- +13 ; to bypass the embossing routines when calling load/edit from IEMM
- +14 ;
- +15 ; DG*5.3*1040 - If variable DGADDRE=-1, branch to RPOUT due to timeout; if DGRPOUT=1, branch to RPOUT as well
- A1 Begin DoDot:1
- +1 WRITE !,"Do you want to ",$SELECT(DGNEW:"enter",1:"edit")," Patient Data"
- +2 SET %=1
- DO YN^DICN
- +3 IF +$GET(DGNEW)
- QUIT
- +4 ; DG*5.3*1040 - Store the return value in DGADDRE
- SET DGADDRE=$$ADD^DGADDUTL($GET(DFN))
- End DoDot:1
- if $GET(DGADDRE)=-1
- GOTO RPOUT
- if '%
- GOTO H
- if %'=1
- GOTO CK
- SET DGRPV=0
- DO EN1^DGRP
- if +$GET(DGRPOUT)
- GOTO RPOUT
- DO MT(DFN)
- DO CP
- if $GET(DGPRFLG)=1
- GOTO Q
- if $GET(SDIEMM)
- GOTO Q
- if '$DATA(DA)
- GOTO Q
- GOTO EMBOS
- +5 ;
- H WRITE !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing."
- +1 GOTO A1
- +2 ;
- +3 ; DG*5.3*1040 - Only do if there wasn't a timeout so branch to RPOUT
- CK SET DGEDCN=1
- if +$GET(DGRPOUT)
- GOTO RPOUT
- DO ^DGRPC
- DO MT(DFN)
- DO CP
- +1 if $GET(DGPRFLG)=1
- GOTO Q
- if $GET(SDIEMM)
- GOTO Q
- +2 IF $GET(DGER)[55
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish to return to Screen #9 to enter missing Income Data? "
- DO ^DIR
- KILL DIR
- +3 ;G:Y ^DGRP9
- +4 ;
- EMBOS ;W ! D EMBOS^DGQEMA G A
- +1 ;DG*5.3*921 Invoke eHMP demographic change checking
- +2 DO T
- +3 GOTO A
- +4 ;
- +5 ;
- +6 ; DG*5.3*1040 - Clean variable DGTMOT
- Q KILL X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,DGTMOT,VET
- QUIT
- +1 ;
- MT(DFN) ; Check if user requires a means test. Ask user if they want to proceedif
- +1 ; one is required
- +2 IF '$DATA(SDIEMM)
- Begin DoDot:1
- +3 NEW DGREQF,DIV
- +4 DO EN^DGMTR
- +5 IF DGREQF
- if $PIECE($$MTS^DGMTU(DFN),U,2)="R"
- DO EDT^DGMTU(DFN,DT)
- +6 QUIT
- End DoDot:1
- +7 IF $DATA(SDIEMM)
- Begin DoDot:1
- +8 NEW DGMTI
- +9 SET DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1)
- +10 IF $PIECE(DGMTI,U,4)="R"
- Begin DoDot:2
- +11 SET DGMT0=$GET(^DGMT(408.31,+DGMTI,0))
- SET DGMTDT=$PIECE(DGMT0,"^")
- +12 IF '$$OKTOCONT(DGMTDT)
- QUIT
- +13 SET DGMTI=+DGMTI
- SET DGMTYPT=1
- SET DGMTACT="COM"
- SET DGMTROU="COM^DGMTEO"
- DO EN^DGMTSC
- End DoDot:2
- IF 1
- +14 IF '$TEST
- DO WARNING
- +15 QUIT
- End DoDot:1
- +16 QUIT
- +17 ;
- WARNING ;
- +1 ;prints a warning to the screen about means test
- +2 ;
- +3 WRITE !!,"A means test for this encounter date was not found and may be required!"
- +4 WRITE !,"Further investigation will be needed."
- +5 WRITE !
- +6 DO PAUSE
- +7 QUIT
- +8 ;
- PAUSE ;
- +1 NEW DIR
- +2 SET DIR(0)="FAO"
- SET DIR("A")="Press ENTER to continue "
- DO ^DIR
- +3 QUIT
- +4 ;
- OKTOCONT(Y) ;
- +1 ;
- +2 NEW DIR
- +3 WRITE !!,"Patient Requires a means Test"
- +4 XECUTE ^DD("DD")
- +5 WRITE !,"Primary Means Test Required from '",Y,"'",!
- +6 ;
- +7 IF $DATA(SDIEMM)
- IF '$DATA(^XUSEC("SCENI MEANS TEST EDIT",DUZ))
- Begin DoDot:1
- +8 WRITE !,$CHAR(7),"You do not have the appropriate IEMM Security Key. Contact your supervisor.",!
- +9 DO PAUSE
- +10 SET Y=0
- End DoDot:1
- GOTO OKQ
- +11 ;
- +12 SET DIR("A")="Do you wish to proceed with the means test at this time"
- +13 SET DIR("B")="YES"
- +14 SET DIR(0)="Y"
- +15 DO ^DIR
- OKQ QUIT $SELECT(Y=1:1,1:0)
- +1 ;
- CP ;If not (autoexempt or MTested) & no CP test this year then
- +1 ;prompt for add/edit cp test
- +2 NEW DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT
- +3 ;USE CP FLAG
- if '$PIECE($GET(^DG(43,1,0)),U,41)
- GOTO QTCP
- +4 SET DGIBDT=$SELECT($DATA(DFN1):9999999-DFN1,1:DT)
- +5 DO EN^DGMTCOR
- +6 IF +$GET(DGNOCOPF)
- SET DGMTCOR=0
- +7 IF DGMTCOR
- DO THRESH^DGMTCOU1(DGIBDT)
- DO EDT^DGMTCOU(DFN,DT)
- +8 KILL DGNOCOPF
- QTCP QUIT
- +1 ;
- T ;
- +1 ;DG*5.3*921- Check to ensure all demographic changes are passed to eHMP 10/2/15
- +2 ;If we are editing demographics for an existing patient, get a snapshot after
- +3 ;the changes and compare the before and after snapshots. If there are ANY changes
- +4 ;invoke the unsolicited update protocol.
- +5 IF DGNEW']""
- Begin DoDot:1
- +6 NEW DGFIELD,DGFILE,DGDA
- +7 DO T59(DFN,"AFTER")
- +8 IF $$T60("BEFORE","AFTER",.DGFIELD)
- SET DGFILE=2
- SET DGDA=DFN
- if $LENGTH($TEXT(DG^HMPEVNT))
- DO DG^HMPEVNT
- End DoDot:1
- +9 QUIT
- +10 ;
- T59(A,B) ;Get all the demographics that are supposed to trigger an unsolicited update
- +1 ;DG*5.3*921
- +2 ;A = DFN
- +3 ;B = Return array
- +4 NEW FLDS,INS
- +5 SET FLDS=".01;.02;.03;.05;.08;.09;.351;.361;.364;.111;.1112;.112;.113;.114;.115;.131;.132;.134;"
- +6 SET FLDS=FLDS_".211;.212;.213;.214;.216;.217;.218;.219;.301;.302;1901;.32102;.32103;.32201;.5295;"
- +7 SET FLDS=FLDS_".133;.1211;.1212;.1213;.1214;.1215;.1216;.331;.332;.333;.334;.335;.336;.337;"
- +8 SET FLDS=FLDS_".338;.339;.33011;.215;.21011;.3731;"
- +9 DO GETS^DIQ(2,A_",",FLDS,,B)
- +10 QUIT
- +11 ;
- T60(A,B,C) ;Compare the before and after arrays to see if any of the considerd demographics
- +1 ;were changed
- +2 ;DG*5.3*921
- +3 ;A = "before" changes array
- +4 ;B = "after" changes array
- +5 ;Both A and B are of the form: A(2,DFN_",",Field#)=Field value. E.g. A(2,"3,",.114)="LOS ANGELES"
- +6 ;C = the first field that was changed (e.g. .111 for street address line 1).
- +7 ; This is an output parameter.
- +8 ;Returns true (1) if any change is detected. Quits at the FIRST find.
- +9 ; false (null) if there are no changes.
- +10 NEW F,X,Y,Z
- +11 SET (C,F,Z)=""
- +12 FOR
- SET Z=$ORDER(@A@(Z))
- if $GET(F)!(Z'=+Z)
- QUIT
- Begin DoDot:1
- +13 SET Y=""
- +14 FOR
- SET Y=$ORDER(@A@(Z,Y))
- if $GET(F)!(Y']"")
- QUIT
- Begin DoDot:2
- +15 SET X=""
- +16 FOR
- SET X=$ORDER(@A@(Z,Y,X))
- if $GET(F)!(X'=+X)
- QUIT
- Begin DoDot:3
- +17 IF @A@(Z,Y,X)'=$GET(@B@(Z,Y,X))
- SET F=1
- SET C=X
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +18 QUIT F
- +19 ; DG*5.3*1040 - Entry point to quit and go to next select patient prompt
- RPOUT ; Entry point if user timeout out
- +1 SET DGRPOUT=""
- +2 GOTO A