PXRMEGED.m

PXRMEGED ; SLC/PJH - Extract Counting Group Editor ;01/28/2013

 ;;2.0;CLINICAL REMINDERS;**4,26**;Feb 04, 2005;Build 404

 ;

 ;Main entry point for PXRM EXTRACT COUNTING GRP EDIT

START(IEN) ;

 N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD

 S X="IORESET"

 D ENDR^%ZISS

 S VALMCNT=0

 D EN^VALM("PXRM EXTRACT COUNTING GRP EDIT")

 Q

 ;

BLDLIST(IEN) ;Build workfile

 N FLDS,GBL,PXRMROOT

 S FLDS="[PXRM EXTRACT COUNTING GROUP]"

 S GBL="^TMP(""PXRMEGED"",$J)"

 S GBL=$NA(@GBL)

 S PXRMROOT="^PXRM(810.8,"

 K ^TMP("PXRMEGED",$J)

 D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)

 S VALMCNT=$O(^TMP("PXRMEGED",$J,""),-1)

 Q

 ;

ENTRY ;Entry code

 D BLDLIST(IEN)

 Q

 ;

EXIT ;Exit code

 K ^TMP("PXRMEGED",$J)

 K ^TMP("PXRMEGEDH",$J)

 D CLEAN^VALM10

 D FULL^VALM1

 S VALMBCK="Q"

 Q

 ;

HDR ; Header code

 S VALMHDR(1)=""

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 Q

 ;

HLP ;Help code

 N ORU,ORUPRMT,SUB,XQORM

 S SUB="PXRMEGEDH"

 D EN^VALM("PXRM EXTRACT HELP")

 Q

 ;

INIT ;Init

 S VALMCNT=0

 Q

 ;

PEXIT ;PXRM EXCH MENU protocol exit code

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 ;Reset after page up/down etc

 Q

 ;

ADD ;Add Rule

 N DA,DIC,DONE,DTOUT,DUOUT,DLAYGO,HED,Y

 S HED="ADD EXTRACT COUNTING GROUP",DONE=0

 W IORESET,!

 F  D  Q:$D(DTOUT)  Q:DONE

 .S DIC="^PXRM(810.8,"

 .;Set the starting place for additions.

 .D SETSTART^PXRMCOPY(DIC)

 .S DIC(0)="AELMQ",DLAYGO=810.8

 .S DIC("A")="Select EXTRACT COUNTING GROUP to add: "

 .D ^DIC

 .I $D(DUOUT) S DTOUT=1

 .I ($D(DTOUT))!($D(DUOUT)) Q

 .I Y=-1 K DIC S DTOUT=1 Q

 .I $P(Y,U,3)'=1 W !,"This extract counting group name already exists" Q

 .S DA=$P(Y,U,1)

 .;Edit Extract Counting Group

 .D EDIT(DA)

 .S:$D(DA) DONE=1,GROUP(DA)=""

 Q

 ;

EDIT(DA) ;Edit Rule

 I '$$VEDIT^PXRMUTIL("^PXRM(810.8,",DA) D  Q

 .W !!,?5,"VA- and national class rules may not be edited" H 2

 .S VALMBCK="R"

 ;

 Q:'$$LOCK(DA)

 W IORESET

 N CS1,CS2,DIC,DIDEL,DIE,DR,DTOUT,DUOUT,ODA,Y

 ;Save checksum

 S CS1=$$FILE^PXRMEXCS(810.8,DA)

 ;

 S DIE="^PXRM(810.8,",DIDEL=810.8,ODA=DA,DR="[PXRM EXTRACT COUNTING GROUP]"

 ;

 ;Edit extract counting group then unlock

 D ^DIE,UNLOCK(ODA)

 ;Deleted ???

 I '$D(DA) S VALMBCK="Q" Q

 ;

 ;Update edit history

 D

 .S CS2=$$FILE^PXRMEXCS(810.8,DA) Q:CS2=CS1  Q:+CS2=0

 .D SEHIST^PXRMUTIL(810.8,DIC,DA)

 ;

 S VALMBCK="R"

 Q

 ;

EGEDIT ;Edit Rule

 D EDIT(IEN) Q:VALMBCK="Q"

 ;

 ;Rebuild Workfile

 D BLDLIST(IEN)

 Q

 ;

LOCK(DA) ;Lock the record

 L +^PXRM(810.7,DA):DILOCKTM I  Q 1

 E  W !!,?5,"Another user is editing this file, try later" H 2 Q 0

 ;

SCREEN ;validate rule type

 Q

 ;

UNLOCK(DA) ;Unlock the record

 L -^PXRM(810.7,DA)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRMEGED   2727     printed  Feb 18, 2025@23:10:51                                                                                                                                                                                                    Page 2

PXRMEGED  ; SLC/PJH - Extract Counting Group Editor ;01/28/2013

 +1       ;;2.0;CLINICAL REMINDERS;**4,26**;Feb 04, 2005;Build 404

 +2       ;

 +3       ;Main entry point for PXRM EXTRACT COUNTING GRP EDIT

START(IEN) ;

 +1        NEW PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD

 +2        SET X="IORESET"

 +3        DO ENDR^%ZISS

 +4        SET VALMCNT=0

 +5        DO EN^VALM("PXRM EXTRACT COUNTING GRP EDIT")

 +6        QUIT 

 +7       ;

BLDLIST(IEN) ;Build workfile

 +1        NEW FLDS,GBL,PXRMROOT

 +2        SET FLDS="[PXRM EXTRACT COUNTING GROUP]"

 +3        SET GBL="^TMP(""PXRMEGED"",$J)"

 +4        SET GBL=$NAME(@GBL)

 +5        SET PXRMROOT="^PXRM(810.8,"

 +6        KILL ^TMP("PXRMEGED",$JOB)

 +7        DO DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)

 +8        SET VALMCNT=$ORDER(^TMP("PXRMEGED",$JOB,""),-1)

 +9        QUIT 

 +10      ;

ENTRY     ;Entry code

 +1        DO BLDLIST(IEN)

 +2        QUIT 

 +3       ;

EXIT      ;Exit code

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

 +2        KILL ^TMP("PXRMEGEDH",$JOB)

 +3        DO CLEAN^VALM10

 +4        DO FULL^VALM1

 +5        SET VALMBCK="Q"

 +6        QUIT 

 +7       ;

HDR       ; Header code

 +1        SET VALMHDR(1)=""

 +2        SET VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 +3        QUIT 

 +4       ;

HLP       ;Help code

 +1        NEW ORU,ORUPRMT,SUB,XQORM

 +2        SET SUB="PXRMEGEDH"

 +3        DO EN^VALM("PXRM EXTRACT HELP")

 +4        QUIT 

 +5       ;

INIT      ;Init

 +1        SET VALMCNT=0

 +2        QUIT 

 +3       ;

PEXIT     ;PXRM EXCH MENU protocol exit code

 +1        SET VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 +2       ;Reset after page up/down etc

 +3        QUIT 

 +4       ;

ADD       ;Add Rule

 +1        NEW DA,DIC,DONE,DTOUT,DUOUT,DLAYGO,HED,Y

 +2        SET HED="ADD EXTRACT COUNTING GROUP"

           SET DONE=0

 +3        WRITE IORESET,!

 +4        FOR 

               Begin DoDot:1

 +5                SET DIC="^PXRM(810.8,"

 +6       ;Set the starting place for additions.

 +7                DO SETSTART^PXRMCOPY(DIC)

 +8                SET DIC(0)="AELMQ"

                   SET DLAYGO=810.8

 +9                SET DIC("A")="Select EXTRACT COUNTING GROUP to add: "

 +10               DO ^DIC

 +11               IF $DATA(DUOUT)

                       SET DTOUT=1

 +12               IF ($DATA(DTOUT))!($DATA(DUOUT))

                       QUIT 

 +13               IF Y=-1

                       KILL DIC

                       SET DTOUT=1

                       QUIT 

 +14               IF $PIECE(Y,U,3)'=1

                       WRITE !,"This extract counting group name already exists"

                       QUIT 

 +15               SET DA=$PIECE(Y,U,1)

 +16      ;Edit Extract Counting Group

 +17               DO EDIT(DA)

 +18               if $DATA(DA)

                       SET DONE=1

                       SET GROUP(DA)=""

               End DoDot:1

               if $DATA(DTOUT)

                   QUIT 

               if DONE

                   QUIT 

 +19       QUIT 

 +20      ;

EDIT(DA)  ;Edit Rule

 +1        IF '$$VEDIT^PXRMUTIL("^PXRM(810.8,",DA)

               Begin DoDot:1

 +2                WRITE !!,?5,"VA- and national class rules may not be edited"

                   HANG 2

 +3                SET VALMBCK="R"

               End DoDot:1

               QUIT 

 +4       ;

 +5        if '$$LOCK(DA)

               QUIT 

 +6        WRITE IORESET

 +7        NEW CS1,CS2,DIC,DIDEL,DIE,DR,DTOUT,DUOUT,ODA,Y

 +8       ;Save checksum

 +9        SET CS1=$$FILE^PXRMEXCS(810.8,DA)

 +10      ;

 +11       SET DIE="^PXRM(810.8,"

           SET DIDEL=810.8

           SET ODA=DA

           SET DR="[PXRM EXTRACT COUNTING GROUP]"

 +12      ;

 +13      ;Edit extract counting group then unlock

 +14       DO ^DIE

           DO UNLOCK(ODA)

 +15      ;Deleted ???

 +16       IF '$DATA(DA)

               SET VALMBCK="Q"

               QUIT 

 +17      ;

 +18      ;Update edit history

 +19       Begin DoDot:1

 +20           SET CS2=$$FILE^PXRMEXCS(810.8,DA)

               if CS2=CS1

                   QUIT 

               if +CS2=0

                   QUIT 

 +21           DO SEHIST^PXRMUTIL(810.8,DIC,DA)

           End DoDot:1

 +22      ;

 +23       SET VALMBCK="R"

 +24       QUIT 

 +25      ;

EGEDIT    ;Edit Rule

 +1        DO EDIT(IEN)

           if VALMBCK="Q"

               QUIT 

 +2       ;

 +3       ;Rebuild Workfile

 +4        DO BLDLIST(IEN)

 +5        QUIT 

 +6       ;

LOCK(DA)  ;Lock the record

 +1        LOCK +^PXRM(810.7,DA):DILOCKTM

          IF $TEST

               QUIT 1

 +2       IF '$TEST

               WRITE !!,?5,"Another user is editing this file, try later"

               HANG 2

               QUIT 0

 +3       ;

SCREEN    ;validate rule type

 +1        QUIT 

 +2       ;

UNLOCK(DA) ;Unlock the record

 +1        LOCK -^PXRM(810.7,DA)

 +2        QUIT