VAQLED02.m

VAQLED02 ;ALB/JFP - PDX, LOAD/EDIT,SETUP OF DIFFERENCES;01MAR93

 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993

EP ; -- Main entry point for the list processor

 ; -- K XQORS,VALMEVL ;(only kill on the first screen in)

 ;

 ;D CLEAR^VALM1

 S VAQBCK=0

 D MAIN^VAQLED04 ; -- collects PDX data and MAS data

 I '$D(^TMP("VAQTR",$J))!('$D(^TMP("VAQPT",$J))) D  QUIT

 .W !,"     Error...No data collected"

 .S VAQFLAG=1 D TRANEX

 D EN^VALM("VAQ LED DIFFERENCES PDX6")

 QUIT

 ;

INIT ; -- Builds array of differences between PDX minimal and the local

 ;    data stored in file 2.

 ;

 K ^TMP("VAQL2",$J)

 K ^TMP("VAQPT",$J,"ID"),^TMP("VAQTR",$J,"ID"),^TMP("VAQLD",$J)

 D EP^VAQLED05

 QUIT

 ;

HD ; -- Make header line for list processor

 D HD1^VAQEXT02 QUIT

 ;

FIELD ; -- Updates local patient file by field or fields selected

 S (VAQFLAG,VAQUPDFL)=0

 D SEL^VALM2

 Q:'$D(VALMY)

 D CLEAR^VALM1

 S ENTRY="" K ^TMP("VAQLD",$J)

 F  S ENTRY=$O(VALMY(ENTRY))  Q:ENTRY=""  D

 .S SDAT=$G(^TMP("VAQIDX",$J,ENTRY))

 .D UPDATE

 I VAQUPDFL=1 D WORKLD

 D EP1^VAQLED05 ; -- Redisplay

 S VALMBCK="R"

 S VAQBCK=1

 QUIT

 ;

UPDATE ; -- Loads fields for update

 S DFNTR=$P(SDAT,U,1)

 S DFNPT=$P(SDAT,U,2)

 I DFNPT="" W !,"Local patient pointer missing... unable to upload field" QUIT

 S (FLE,LFLE)=$P(SDAT,U,3)

 S FLD=$P(SDAT,U,4)

 S SEQ=$P(SDAT,U,5)

 S MFLAG=$P(SDAT,U,6)

 I LFLE'=2 S LFLE=2 ; -- only lock top level file

 S LOCKFLE=$G(^DIC(LFLE,0,"GL"))

 L +(@(LOCKFLE_DFNPT_")")):60

 I ('$T) W !,"Could not edit entry... record locked" K LOCKFLE  QUIT

 D:MFLAG="" UPDTER1

 D:MFLAG="M" UPDTEM1

 L -(@(LOCKFLE_DFNPT_")")) K LOCKFLE

 ; -- data loaded

 S VAQUPDFL=1

 I '($D(Y)#2) D KILL QUIT

 S ^TMP("VAQLD",$J,ENTRY)=FLE_"^"_FLD ; -- data not pass input transform

 QUIT

 ;

UPDTER1 ;  -- Updates patient with PDX data (field by field) ** NON MUTIPLE **

 S DIE=$G(^DIC(FLE,0,"GL"))

 S DA=DFNPT

 S DR=FLD_"///^S X=$G(^TMP(""VAQTR"",$J,""VALUE"",FLE,FLD,0))"

 D ^DIE

 K DIE,DA,DR

 QUIT

 ;

UPDTEM1 ;  -- Updates patient with PDX data (field by field) ** MULTIPLE **

 ;     Loads pointer to main file

 S MFLE=$G(^DD(FLE,0,"UP")) ; -- main file

 S MFLD="",MFLD=$O(^DD(MFLE,"SB",FLE,MFLD))

 S FLD=.01

 S DIE=$G(^DIC(MFLE,0,"GL"))

 S DA=DFNPT

 S DR=MFLD_"///"_$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))

 D UPDTEM2

 D ^DIE

 K DIE,DA,DR,MFLE,MFLD,VALUE

 QUIT

 ;

UPDTEM2 ; -- Load fields into sub file for entry

 F  S FLD=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD))  Q:FLD=""  D

 .S VALUE=FLD_"///"_$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))

 .S DR(2,FLE)=VALUE

 .S DR(2,FLE,FLD)=VALUE

 QUIT

 ;

LOAD ;  -- Loads all different fields from PDX segment to local patient file

 I '$D(^TMP("VAQIDX",$J)) S VALMBCK="Q"  QUIT

 S (VAQFLAG,VAQUPDFL)=0

 D CLEAR^VALM1

 S ENTRY="" K ^TMP("VAQLD",$J)

 F  S ENTRY=$O(^TMP("VAQIDX",$J,ENTRY))  Q:ENTRY=""  D

 .S SDAT=$G(^TMP("VAQIDX",$J,ENTRY))

 .D UPDATE

 I VAQUPDFL=1 D WORKLD

 D EP1^VAQLED05

 S VALMBCK="R"

 S VAQBCK=1

 QUIT

 ;

TRANEX ; -- Pauses screen

 D PAUSE^VALM1

 S:'$D(VAQFLAG) VAQFLAG=""

 S VALMBCK=$S(VAQFLAG=0:"R",1:"Q")

 QUIT

 ;

WORKLD ; -- Updates workload file for update

 S X=$$WORKDONE^VAQADS01("UPDTE",DFNTR,$G(DUZ))

 I X<0 W !,"Error updating workload file (UPDTE)... "_$P(X,U,2)

 I $P($G(^VAT(394.61,DFNTR,0)),U,4)=0 QUIT

 S X=$$WORKDONE^VAQADS01("SNSTVE",DFNTR,$G(DUZ))

 I X<0 W !,"Error updating workload file (SNSTVE)... "_$P(X,U,2)

 QUIT

 ;

KILL ; --

 K ^TMP("VAQTR",$J,"VALUE",FLE,$S(MFLAG="M":.01,1:FLD),SEQ)

 K ^TMP("VAQPT",$J,"VALUE",FLE,$S(MFLAG="M":.01,1:FLD),SEQ)

 QUIT

 ;

EXIT ; -- Note: The list processor cleans up its own variables.

 ;          All other variables cleaned up here.

 ;

 K ^TMP("VAQL2",$J),^TMP("VAQIDX",$J)

 K ^TMP("VAQPT",$J),^TMP("VAQTR",$J),^TMP("VAQLD",$J)

 K VAQFLAG,VAQUPDFL

 K DFNTR,DFNPT,FLE,FLD,SEQ,MFLAG,LFLE

 Q

 ;

END ; -- End of code

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VAQLED02   3913     printed  Feb 18, 2025@23:52:02                                                                                                                                                                                                    Page 2

VAQLED02  ;ALB/JFP - PDX, LOAD/EDIT,SETUP OF DIFFERENCES;01MAR93

 +1       ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993

EP        ; -- Main entry point for the list processor

 +1       ; -- K XQORS,VALMEVL ;(only kill on the first screen in)

 +2       ;

 +3       ;D CLEAR^VALM1

 +4        SET VAQBCK=0

 +5       ; -- collects PDX data and MAS data

           DO MAIN^VAQLED04

 +6        IF '$DATA(^TMP("VAQTR",$JOB))!('$DATA(^TMP("VAQPT",$JOB)))

               Begin DoDot:1

 +7                WRITE !,"     Error...No data collected"

 +8                SET VAQFLAG=1

                   DO TRANEX

               End DoDot:1

               QUIT 

 +9        DO EN^VALM("VAQ LED DIFFERENCES PDX6")

 +10       QUIT 

 +11      ;

INIT      ; -- Builds array of differences between PDX minimal and the local

 +1       ;    data stored in file 2.

 +2       ;

 +3        KILL ^TMP("VAQL2",$JOB)

 +4        KILL ^TMP("VAQPT",$JOB,"ID"),^TMP("VAQTR",$JOB,"ID"),^TMP("VAQLD",$JOB)

 +5        DO EP^VAQLED05

 +6        QUIT 

 +7       ;

HD        ; -- Make header line for list processor

 +1        DO HD1^VAQEXT02

           QUIT 

 +2       ;

FIELD     ; -- Updates local patient file by field or fields selected

 +1        SET (VAQFLAG,VAQUPDFL)=0

 +2        DO SEL^VALM2

 +3        if '$DATA(VALMY)

               QUIT 

 +4        DO CLEAR^VALM1

 +5        SET ENTRY=""

           KILL ^TMP("VAQLD",$JOB)

 +6        FOR 

               SET ENTRY=$ORDER(VALMY(ENTRY))

               if ENTRY=""

                   QUIT 

               Begin DoDot:1

 +7                SET SDAT=$GET(^TMP("VAQIDX",$JOB,ENTRY))

 +8                DO UPDATE

               End DoDot:1

 +9        IF VAQUPDFL=1

               DO WORKLD

 +10      ; -- Redisplay

           DO EP1^VAQLED05

 +11       SET VALMBCK="R"

 +12       SET VAQBCK=1

 +13       QUIT 

 +14      ;

UPDATE    ; -- Loads fields for update

 +1        SET DFNTR=$PIECE(SDAT,U,1)

 +2        SET DFNPT=$PIECE(SDAT,U,2)

 +3        IF DFNPT=""

               WRITE !,"Local patient pointer missing... unable to upload field"

               QUIT 

 +4        SET (FLE,LFLE)=$PIECE(SDAT,U,3)

 +5        SET FLD=$PIECE(SDAT,U,4)

 +6        SET SEQ=$PIECE(SDAT,U,5)

 +7        SET MFLAG=$PIECE(SDAT,U,6)

 +8       ; -- only lock top level file

           IF LFLE'=2

               SET LFLE=2

 +9        SET LOCKFLE=$GET(^DIC(LFLE,0,"GL"))

 +10       LOCK +(@(LOCKFLE_DFNPT_")")):60

 +11       IF ('$TEST)

               WRITE !,"Could not edit entry... record locked"

               KILL LOCKFLE

               QUIT 

 +12       if MFLAG=""

               DO UPDTER1

 +13       if MFLAG="M"

               DO UPDTEM1

 +14       LOCK -(@(LOCKFLE_DFNPT_")"))

           KILL LOCKFLE

 +15      ; -- data loaded

 +16       SET VAQUPDFL=1

 +17       IF '($DATA(Y)#2)

               DO KILL

               QUIT 

 +18      ; -- data not pass input transform

           SET ^TMP("VAQLD",$JOB,ENTRY)=FLE_"^"_FLD

 +19       QUIT 

 +20      ;

UPDTER1   ;  -- Updates patient with PDX data (field by field) ** NON MUTIPLE **

 +1        SET DIE=$GET(^DIC(FLE,0,"GL"))

 +2        SET DA=DFNPT

 +3        SET DR=FLD_"///^S X=$G(^TMP(""VAQTR"",$J,""VALUE"",FLE,FLD,0))"

 +4        DO ^DIE

 +5        KILL DIE,DA,DR

 +6        QUIT 

 +7       ;

UPDTEM1   ;  -- Updates patient with PDX data (field by field) ** MULTIPLE **

 +1       ;     Loads pointer to main file

 +2       ; -- main file

           SET MFLE=$GET(^DD(FLE,0,"UP"))

 +3        SET MFLD=""

           SET MFLD=$ORDER(^DD(MFLE,"SB",FLE,MFLD))

 +4        SET FLD=.01

 +5        SET DIE=$GET(^DIC(MFLE,0,"GL"))

 +6        SET DA=DFNPT

 +7        SET DR=MFLD_"///"_$GET(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD,SEQ))

 +8        DO UPDTEM2

 +9        DO ^DIE

 +10       KILL DIE,DA,DR,MFLE,MFLD,VALUE

 +11       QUIT 

 +12      ;

UPDTEM2   ; -- Load fields into sub file for entry

 +1        FOR 

               SET FLD=$ORDER(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD))

               if FLD=""

                   QUIT 

               Begin DoDot:1

 +2                SET VALUE=FLD_"///"_$GET(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD,SEQ))

 +3                SET DR(2,FLE)=VALUE

 +4                SET DR(2,FLE,FLD)=VALUE

               End DoDot:1

 +5        QUIT 

 +6       ;

LOAD      ;  -- Loads all different fields from PDX segment to local patient file

 +1        IF '$DATA(^TMP("VAQIDX",$JOB))

               SET VALMBCK="Q"

               QUIT 

 +2        SET (VAQFLAG,VAQUPDFL)=0

 +3        DO CLEAR^VALM1

 +4        SET ENTRY=""

           KILL ^TMP("VAQLD",$JOB)

 +5        FOR 

               SET ENTRY=$ORDER(^TMP("VAQIDX",$JOB,ENTRY))

               if ENTRY=""

                   QUIT 

               Begin DoDot:1

 +6                SET SDAT=$GET(^TMP("VAQIDX",$JOB,ENTRY))

 +7                DO UPDATE

               End DoDot:1

 +8        IF VAQUPDFL=1

               DO WORKLD

 +9        DO EP1^VAQLED05

 +10       SET VALMBCK="R"

 +11       SET VAQBCK=1

 +12       QUIT 

 +13      ;

TRANEX    ; -- Pauses screen

 +1        DO PAUSE^VALM1

 +2        if '$DATA(VAQFLAG)

               SET VAQFLAG=""

 +3        SET VALMBCK=$SELECT(VAQFLAG=0:"R",1:"Q")

 +4        QUIT 

 +5       ;

WORKLD    ; -- Updates workload file for update

 +1        SET X=$$WORKDONE^VAQADS01("UPDTE",DFNTR,$GET(DUZ))

 +2        IF X<0

               WRITE !,"Error updating workload file (UPDTE)... "_$PIECE(X,U,2)

 +3        IF $PIECE($GET(^VAT(394.61,DFNTR,0)),U,4)=0

               QUIT 

 +4        SET X=$$WORKDONE^VAQADS01("SNSTVE",DFNTR,$GET(DUZ))

 +5        IF X<0

               WRITE !,"Error updating workload file (SNSTVE)... "_$PIECE(X,U,2)

 +6        QUIT 

 +7       ;

KILL      ; --

 +1        KILL ^TMP("VAQTR",$JOB,"VALUE",FLE,$SELECT(MFLAG="M":.01,1:FLD),SEQ)

 +2        KILL ^TMP("VAQPT",$JOB,"VALUE",FLE,$SELECT(MFLAG="M":.01,1:FLD),SEQ)

 +3        QUIT 

 +4       ;

EXIT      ; -- Note: The list processor cleans up its own variables.

 +1       ;          All other variables cleaned up here.

 +2       ;

 +3        KILL ^TMP("VAQL2",$JOB),^TMP("VAQIDX",$JOB)

 +4        KILL ^TMP("VAQPT",$JOB),^TMP("VAQTR",$JOB),^TMP("VAQLD",$JOB)

 +5        KILL VAQFLAG,VAQUPDFL

 +6        KILL DFNTR,DFNPT,FLE,FLD,SEQ,MFLAG,LFLE

 +7        QUIT 

 +8       ;

END       ; -- End of code

 +1        QUIT