DGPTAEE.m

DGPTAEE ;ALB/MTC,HIOFO/FT - Austin Edit Checks Error Driver ;7/6/15 10:06am

 ;;5.3;Registration;**64,338,678,850,884**;Aug 13, 1993;Build 31

 ;

 ;no external references

 ;

EN ;-- entry point for list manager

 D BUILD

 Q

 ;

HDR ;-- header function for Editing List.

 S VALMHDR(1)="Patient : "_$P($G(^DPT(DFN,0)),U)

 S VALMHDR(2)="Admission Date : "_$$FTIME^VALM1($P(^DGPT(PTF,0),U,2))

 S VALMHDR(3)="Discharge Date : "_$$FTIME^VALM1($P(^DGPT(PTF,70),U))

 Q

 ;

BUILD ;-- this function will build the display array - similar to Austin's EAL

 ;

 Q:'$D(^TMP("AERROR",$J))!'($D(^TMP("AEDIT",$J)))

 K ^TMP("AD",$J)

 N NODE,SEQ,DGER,ERSTR,SP,ROU,REC,DGPTLINE,DGPTLGTH,DGFLAG

 S (DGFLAG,VALMCNT,SEQ)=0,NODE="",SP=" "

 F  S SEQ=$O(^TMP("AERROR",$J,SEQ)) Q:SEQ=""  D

 . S NODE=$O(^TMP("AERROR",$J,SEQ,0))

 . S DGFLAG=$S(NODE="N101":1,NODE="N401":1,NODE="N501":1,NODE="N601":1,NODE="N701":1,NODE="N702":1,1:0)

 . Q:DGFLAG=0

 . Q:'$D(^TMP("AERROR",$J,SEQ,NODE))

 . S REC=$G(^TMP("AEDIT",$J,NODE,SEQ))

 . Q:REC=""

 . S DGPTLGTH=$L(REC),DGPTLINE=1

 . S:NODE="N101" DGPTLINE=$S(DGPTLGTH=125:1,1:2)  ;1 is for ICD9 layout, 2 is for ICD10 layout

 . S:NODE="N401" DGPTLINE=$S(DGPTLGTH=125:1,1:2)

 . S:NODE="N501" DGPTLINE=$S(DGPTLGTH=125:1,1:2)

 . S:NODE="N601" DGPTLINE=$S(DGPTLGTH=125:1,1:2)

 . S:NODE="N701" DGPTLINE=$S(DGPTLGTH=125:1,1:2)

 . S:NODE="N702" DGPTLINE=$S(DGPTLGTH=125:1,1:2)

 . S ERSTR=$P($T(@("ER"_$E(NODE,2,4))+DGPTLINE),";;",2) D LOADER

 . S ROU="H"_$E(NODE,2,4)_"^"_$S(NODE="N101"!(NODE="N401")!(NODE="N501"):"DGPTAEE1",1:"DGPTAEE2")_"(REC)" D @ROU

 Q

 ;

EXIT ;-- exit point for list manager

 K ^TMP("AD",$J)

 D CLEAR^VALM1

 Q

 ;

LOADER ;-- This function will load the array DGER

 ;

 N Y,J,X1,X2

 K DGER

 S DGER=""

 S Y="",J=0 F  S J=$O(^TMP("AERROR",$J,SEQ,NODE,J)) Q:'J  S X2=$G(^(J)) D

 . S X1=$O(^DGP(45.64,"B",$G(X2),0)),Y=$G(^DGP(45.64,+$G(X1),0))

 . S DGER(J)=Y,DGER=DGER_$P(ERSTR,U,$P(Y,U,3))_","

 S DGER=$E(DGER,1,$L(DGER)-1)

 Q

 ;

WRER ;-- This function will write errors in DGER into ^TMP

 ;

 N I

 S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)="Error Code(s) : "

 S I="" F  S I=$O(DGER(I)) Q:'I  D

 . S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=$P(DGER(I),U)_" - "_$P(DGER(I),U,2)

 D TRTCHK

 I '$G(DGPTERR) S VALMCNT=VALMCNT+1,$P(^TMP("AD",$J,VALMCNT,0),"=",80)=""

 K DGPTERR

 Q

 ;

 ;-- This data is used to determine where in the output string a '#'

 ;   should be printed. The format of the each datum is:

 ;      <position in transmission string>:<position in display string>

 ;  first ";;" line represents ICD9 layout

 ; second" ;;" line represents ICD10 layout

ER101 ;-- 101 error position string

 ;;1:1^2:8^3:18^4:32^5:47^6:52^7:55^8:62^9:66^10:70^11:73^12:1^13:15^14:20^15:24^16:27^17:34^18:41^19:44^20:52^^^^24:71

 ;;1:1^2:8^3:18^4:32^5:47^6:52^7:55^8:62^9:66^10:70^11:73^12:1^13:15^14:20^15:24^16:27^17:34^18:41^19:44^20:52^^^^24:71

 ;

ER501 ;-- 501 error position string

 ;;1:1^2:8^3:18^4:32^5:47^6:56^7:60^8:64^9:69^10:1^11:9^12:17^13:25^14:33^15:1^16:14^17:23^18:27^19:31^20:34^21:37^22:42^23:45:^24:50^

 ;;1:1^2:8^3:18^4:32^5:47^6:56^7:60^8:64^9:69^10:1^11:10^12:20^13:30^14:40^15:1^16:10^17:20^18:30^19:40^20:1^21:20^22:30^23:30^24:40^25:1^26:20^27:30^28:30^29:40^30:1^31:20^32:30^33:30^34:40

 ;

ER401 ;-- 401 error position string

 ;;1:1^2:8^3:18^4:32^5:48^6:53^7:59^8:64^9:1^10:9^11:17^12:25^13:33^14:42^15:52^

 ;;1:1^2:8^3:18^4:32^5:48^6:53^7:59^8:64^9:1^10:9^11:17^12:25^13:33^14:1^15:9^16:17^17:25^18:33^19:1^20:9^21:17^22:25^23:33^24:1^25:9^26:17^27:25^28:33^29:1^30:9^31:17^32:25^33:33

 ;

ER601 ;-- 601 error position string

 ;;1:1^2:10^3:18^4:32^5:47^6:52^7:57^8:1^9:9^10:17^11:25^12:33^

 ;;1:1^2:10^3:18^4:32^5:47^6:52^7:57^8:1^9:9^10:17^11:25^12:33^13:1^14:9^15:17^16:25^17:33^18:1^19:9^20:17^21:25^22:33^23:1^24:9^25:17^26:25^27:33^28:1^29:9^30:17^31:25^32:33

 ;

ER701 ;-- 701 error position string

 ;;1:1^2:8^3:18^4:32^5:46^6:51^7:56^8:62^9:69^10:75^11:1^12:8^13:12^14:16^15:23^16:28^17:39^18:48^19:52^20:55^21:58^22:63^23:66^

 ;;1:1^2:8^3:18^4:32^5:46^6:51^7:56^8:62^9:69^10:75^11:1^12:8^13:12^14:16^15:23^16:28^17:39^18:48^19:52^20:55^21:58^22:63^23:66^24:1^25:4^26:8^27:12^28:16^29:20^30:25^31:30^32:50^33:55

 ;

ER702 ;-- 702 error position string

 ;;1:1^2:8^3:18^4:32^5:1^6:9^7:17^8:25^9:33^10:41^11:49^12:57^13:65^

 ;;1:1^2:8^3:18^4:32^5:1^6:9^7:17^8:25^9:33^10:1^11:9^12:17^13:25^14:33^15:1^16:9^17:17^18:25^19:33^20:1^21:9^22:17^23:25^24:33^25:1^26:9^27:17^28:25^29:33

 ;

TRTCHK ;-- Check for treating spec error flag and print error message if flag

 ;-- exists.

 N I,X

 S I=0,I=$O(DGPTSER(I)) G:'I TRTCHKQ

 I $G(DGPTSER(+I))=1 D

 . S X="*** Bed section code is not active for the date/time period listed. ***"

 . S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X,DGPTERR=1

TRTCHKQ K DGPTSER(+I)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPTAEE   4843     printed  Feb 19, 2025@00:17:36                                                                                                                                                                                                     Page 2

DGPTAEE   ;ALB/MTC,HIOFO/FT - Austin Edit Checks Error Driver ;7/6/15 10:06am

 +1       ;;5.3;Registration;**64,338,678,850,884**;Aug 13, 1993;Build 31

 +2       ;

 +3       ;no external references

 +4       ;

EN        ;-- entry point for list manager

 +1        DO BUILD

 +2        QUIT 

 +3       ;

HDR       ;-- header function for Editing List.

 +1        SET VALMHDR(1)="Patient : "_$PIECE($GET(^DPT(DFN,0)),U)

 +2        SET VALMHDR(2)="Admission Date : "_$$FTIME^VALM1($PIECE(^DGPT(PTF,0),U,2))

 +3        SET VALMHDR(3)="Discharge Date : "_$$FTIME^VALM1($PIECE(^DGPT(PTF,70),U))

 +4        QUIT 

 +5       ;

BUILD     ;-- this function will build the display array - similar to Austin's EAL

 +1       ;

 +2        if '$DATA(^TMP("AERROR",$JOB))!'($DATA(^TMP("AEDIT",$JOB)))

               QUIT 

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

 +4        NEW NODE,SEQ,DGER,ERSTR,SP,ROU,REC,DGPTLINE,DGPTLGTH,DGFLAG

 +5        SET (DGFLAG,VALMCNT,SEQ)=0

           SET NODE=""

           SET SP=" "

 +6        FOR 

               SET SEQ=$ORDER(^TMP("AERROR",$JOB,SEQ))

               if SEQ=""

                   QUIT 

               Begin DoDot:1

 +7                SET NODE=$ORDER(^TMP("AERROR",$JOB,SEQ,0))

 +8                SET DGFLAG=$SELECT(NODE="N101":1,NODE="N401":1,NODE="N501":1,NODE="N601":1,NODE="N701":1,NODE="N702":1,1:0)

 +9                if DGFLAG=0

                       QUIT 

 +10               if '$DATA(^TMP("AERROR",$JOB,SEQ,NODE))

                       QUIT 

 +11               SET REC=$GET(^TMP("AEDIT",$JOB,NODE,SEQ))

 +12               if REC=""

                       QUIT 

 +13               SET DGPTLGTH=$LENGTH(REC)

                   SET DGPTLINE=1

 +14      ;1 is for ICD9 layout, 2 is for ICD10 layout

                   if NODE="N101"

                       SET DGPTLINE=$SELECT(DGPTLGTH=125:1,1:2)

 +15               if NODE="N401"

                       SET DGPTLINE=$SELECT(DGPTLGTH=125:1,1:2)

 +16               if NODE="N501"

                       SET DGPTLINE=$SELECT(DGPTLGTH=125:1,1:2)

 +17               if NODE="N601"

                       SET DGPTLINE=$SELECT(DGPTLGTH=125:1,1:2)

 +18               if NODE="N701"

                       SET DGPTLINE=$SELECT(DGPTLGTH=125:1,1:2)

 +19               if NODE="N702"

                       SET DGPTLINE=$SELECT(DGPTLGTH=125:1,1:2)

 +20               SET ERSTR=$PIECE($TEXT(@("ER"_$EXTRACT(NODE,2,4))+DGPTLINE),";;",2)

                   DO LOADER

 +21               SET ROU="H"_$EXTRACT(NODE,2,4)_"^"_$SELECT(NODE="N101"!(NODE="N401")!(NODE="N501"):"DGPTAEE1",1:"DGPTAEE2")_"(REC)"

                   DO @ROU

               End DoDot:1

 +22       QUIT 

 +23      ;

EXIT      ;-- exit point for list manager

 +1        KILL ^TMP("AD",$JOB)

 +2        DO CLEAR^VALM1

 +3        QUIT 

 +4       ;

LOADER    ;-- This function will load the array DGER

 +1       ;

 +2        NEW Y,J,X1,X2

 +3        KILL DGER

 +4        SET DGER=""

 +5        SET Y=""

           SET J=0

           FOR 

               SET J=$ORDER(^TMP("AERROR",$JOB,SEQ,NODE,J))

               if 'J

                   QUIT 

               SET X2=$GET(^(J))

               Begin DoDot:1

 +6                SET X1=$ORDER(^DGP(45.64,"B",$GET(X2),0))

                   SET Y=$GET(^DGP(45.64,+$GET(X1),0))

 +7                SET DGER(J)=Y

                   SET DGER=DGER_$PIECE(ERSTR,U,$PIECE(Y,U,3))_","

               End DoDot:1

 +8        SET DGER=$EXTRACT(DGER,1,$LENGTH(DGER)-1)

 +9        QUIT 

 +10      ;

WRER      ;-- This function will write errors in DGER into ^TMP

 +1       ;

 +2        NEW I

 +3        SET VALMCNT=VALMCNT+1

           SET ^TMP("AD",$JOB,VALMCNT,0)="Error Code(s) : "

 +4        SET I=""

           FOR 

               SET I=$ORDER(DGER(I))

               if 'I

                   QUIT 

               Begin DoDot:1

 +5                SET VALMCNT=VALMCNT+1

                   SET ^TMP("AD",$JOB,VALMCNT,0)=$PIECE(DGER(I),U)_" - "_$PIECE(DGER(I),U,2)

               End DoDot:1

 +6        DO TRTCHK

 +7        IF '$GET(DGPTERR)

               SET VALMCNT=VALMCNT+1

               SET $PIECE(^TMP("AD",$JOB,VALMCNT,0),"=",80)=""

 +8        KILL DGPTERR

 +9        QUIT 

 +10      ;

 +11      ;-- This data is used to determine where in the output string a '#'

 +12      ;   should be printed. The format of the each datum is:

 +13      ;      <position in transmission string>:<position in display string>

 +14      ;  first ";;" line represents ICD9 layout

 +15      ; second" ;;" line represents ICD10 layout

ER101     ;-- 101 error position string

 +1       ;;1:1^2:8^3:18^4:32^5:47^6:52^7:55^8:62^9:66^10:70^11:73^12:1^13:15^14:20^15:24^16:27^17:34^18:41^19:44^20:52^^^^24:71

 +2       ;;1:1^2:8^3:18^4:32^5:47^6:52^7:55^8:62^9:66^10:70^11:73^12:1^13:15^14:20^15:24^16:27^17:34^18:41^19:44^20:52^^^^24:71

 +3       ;

ER501     ;-- 501 error position string

 +1       ;;1:1^2:8^3:18^4:32^5:47^6:56^7:60^8:64^9:69^10:1^11:9^12:17^13:25^14:33^15:1^16:14^17:23^18:27^19:31^20:34^21:37^22:42^23:45:^24:50^

 +2       ;;1:1^2:8^3:18^4:32^5:47^6:56^7:60^8:64^9:69^10:1^11:10^12:20^13:30^14:40^15:1^16:10^17:20^18:30^19:40^20:1^21:20^22:30^23:30^24:40^25:1^26:20^27:30^28:30^29:40^30:1^31:20^32:30^33:30^34:40

 +3       ;

ER401     ;-- 401 error position string

 +1       ;;1:1^2:8^3:18^4:32^5:48^6:53^7:59^8:64^9:1^10:9^11:17^12:25^13:33^14:42^15:52^

 +2       ;;1:1^2:8^3:18^4:32^5:48^6:53^7:59^8:64^9:1^10:9^11:17^12:25^13:33^14:1^15:9^16:17^17:25^18:33^19:1^20:9^21:17^22:25^23:33^24:1^25:9^26:17^27:25^28:33^29:1^30:9^31:17^32:25^33:33

 +3       ;

ER601     ;-- 601 error position string

 +1       ;;1:1^2:10^3:18^4:32^5:47^6:52^7:57^8:1^9:9^10:17^11:25^12:33^

 +2       ;;1:1^2:10^3:18^4:32^5:47^6:52^7:57^8:1^9:9^10:17^11:25^12:33^13:1^14:9^15:17^16:25^17:33^18:1^19:9^20:17^21:25^22:33^23:1^24:9^25:17^26:25^27:33^28:1^29:9^30:17^31:25^32:33

 +3       ;

ER701     ;-- 701 error position string

 +1       ;;1:1^2:8^3:18^4:32^5:46^6:51^7:56^8:62^9:69^10:75^11:1^12:8^13:12^14:16^15:23^16:28^17:39^18:48^19:52^20:55^21:58^22:63^23:66^

 +2       ;;1:1^2:8^3:18^4:32^5:46^6:51^7:56^8:62^9:69^10:75^11:1^12:8^13:12^14:16^15:23^16:28^17:39^18:48^19:52^20:55^21:58^22:63^23:66^24:1^25:4^26:8^27:12^28:16^29:20^30:25^31:30^32:50^33:55

 +3       ;

ER702     ;-- 702 error position string

 +1       ;;1:1^2:8^3:18^4:32^5:1^6:9^7:17^8:25^9:33^10:41^11:49^12:57^13:65^

 +2       ;;1:1^2:8^3:18^4:32^5:1^6:9^7:17^8:25^9:33^10:1^11:9^12:17^13:25^14:33^15:1^16:9^17:17^18:25^19:33^20:1^21:9^22:17^23:25^24:33^25:1^26:9^27:17^28:25^29:33

 +3       ;

TRTCHK    ;-- Check for treating spec error flag and print error message if flag

 +1       ;-- exists.

 +2        NEW I,X

 +3        SET I=0

           SET I=$ORDER(DGPTSER(I))

           if 'I

               GOTO TRTCHKQ

 +4        IF $GET(DGPTSER(+I))=1

               Begin DoDot:1

 +5                SET X="*** Bed section code is not active for the date/time period listed. ***"

 +6                SET VALMCNT=VALMCNT+1

                   SET ^TMP("AD",$JOB,VALMCNT,0)=X

                   SET DGPTERR=1

               End DoDot:1

TRTCHKQ    KILL DGPTSER(+I)

 +1        QUIT