- PXRMEPED ; SLC/PJH - Extract Definition Editor ;01/28/2013
- ;;2.0;CLINICAL REMINDERS;**4,26**;Feb 04, 2005;Build 404
- ;
- ;Main entry point for PXRM EXTRACT DEFINITION EDIT/DISPLAY
- 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 DEFINITION EDIT")
- Q
- ;
- BLDLIST(IEN) ;Build workfile
- N FLDS,GBL,PXRMROOT
- S FLDS="[PXRM EXTRACT DEFINITION]"
- S GBL="^TMP(""PXRMEPED"",$J)"
- S GBL=$NA(@GBL)
- S PXRMROOT="^PXRM(810.2,"
- K ^TMP("PXRMLRED",$J)
- D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
- S VALMCNT=$O(^TMP("PXRMEPED",$J,""),-1)
- Q
- ;
- ENTRY ;Entry code
- D BLDLIST(IEN)
- Q
- ;
- EXIT ;Exit code
- K ^TMP("PXRMEPED",$J)
- K ^TMP("PXRMEPEDH",$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="PXRMEPEDH"
- D EN^VALM("PXRM EXTRACT HELP")
- Q
- ;
- INIT ;Init
- S VALMCNT=0
- Q
- ;
- PEXIT ;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 DEFINITION",DONE=0
- W IORESET,!
- F D Q:$D(DTOUT) Q:DONE
- .S DIC="^PXRM(810.2,"
- .;Set the starting place for additions.
- .D SETSTART^PXRMCOPY(DIC)
- .S DIC(0)="AELMQ",DLAYGO=810.2
- .S DIC("A")="Select EXTRACT DEFINITION 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 definition name already exists" Q
- .S DA=$P(Y,U,1)
- .;Edit Extract Definition
- .D EDIT(DA)
- .S:$D(DA) DONE=1
- Q
- ;
- EDIT(DA) ;Edit Rule
- I '$$VEDIT^PXRMUTIL("^PXRM(810.2,",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.2,DA)
- ;
- S DIE="^PXRM(810.2,",DIDEL=810.2,ODA=DA,DR="[PXRM EXTRACT DEFINITION]"
- ;
- ;Edit extract definition then unlock
- D ^DIE,UNLOCK(ODA)
- ;Deleted ???
- I '$D(DA) S VALMBCK="Q" Q
- ;
- ;Update edit history
- D
- .S CS2=$$FILE^PXRMEXCS(810.2,DA) Q:CS2=CS1 Q:+CS2=0
- .D SEHIST^PXRMUTIL(810.2,DIC,DA)
- ;
- S VALMBCK="R"
- Q
- ;
- EPEDIT ;Edit Rule
- D EDIT(IEN) Q:VALMBCK="Q"
- ;
- ;Rebuild Workfile
- D BLDLIST(IEN)
- Q
- ;
- LOCK(DA) ;Lock the record
- L +^PXRM(810.2,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.2,DA)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEPED 2671 printed Jan 18, 2025@02:45:47 Page 2
- PXRMEPED ; SLC/PJH - Extract Definition Editor ;01/28/2013
- +1 ;;2.0;CLINICAL REMINDERS;**4,26**;Feb 04, 2005;Build 404
- +2 ;
- +3 ;Main entry point for PXRM EXTRACT DEFINITION EDIT/DISPLAY
- 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 DEFINITION EDIT")
- +6 QUIT
- +7 ;
- BLDLIST(IEN) ;Build workfile
- +1 NEW FLDS,GBL,PXRMROOT
- +2 SET FLDS="[PXRM EXTRACT DEFINITION]"
- +3 SET GBL="^TMP(""PXRMEPED"",$J)"
- +4 SET GBL=$NAME(@GBL)
- +5 SET PXRMROOT="^PXRM(810.2,"
- +6 KILL ^TMP("PXRMLRED",$JOB)
- +7 DO DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
- +8 SET VALMCNT=$ORDER(^TMP("PXRMEPED",$JOB,""),-1)
- +9 QUIT
- +10 ;
- ENTRY ;Entry code
- +1 DO BLDLIST(IEN)
- +2 QUIT
- +3 ;
- EXIT ;Exit code
- +1 KILL ^TMP("PXRMEPED",$JOB)
- +2 KILL ^TMP("PXRMEPEDH",$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="PXRMEPEDH"
- +3 DO EN^VALM("PXRM EXTRACT HELP")
- +4 QUIT
- +5 ;
- INIT ;Init
- +1 SET VALMCNT=0
- +2 QUIT
- +3 ;
- PEXIT ;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 DEFINITION"
- SET DONE=0
- +3 WRITE IORESET,!
- +4 FOR
- Begin DoDot:1
- +5 SET DIC="^PXRM(810.2,"
- +6 ;Set the starting place for additions.
- +7 DO SETSTART^PXRMCOPY(DIC)
- +8 SET DIC(0)="AELMQ"
- SET DLAYGO=810.2
- +9 SET DIC("A")="Select EXTRACT DEFINITION 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 definition name already exists"
- QUIT
- +15 SET DA=$PIECE(Y,U,1)
- +16 ;Edit Extract Definition
- +17 DO EDIT(DA)
- +18 if $DATA(DA)
- SET DONE=1
- End DoDot:1
- if $DATA(DTOUT)
- QUIT
- if DONE
- QUIT
- +19 QUIT
- +20 ;
- EDIT(DA) ;Edit Rule
- +1 IF '$$VEDIT^PXRMUTIL("^PXRM(810.2,",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.2,DA)
- +10 ;
- +11 SET DIE="^PXRM(810.2,"
- SET DIDEL=810.2
- SET ODA=DA
- SET DR="[PXRM EXTRACT DEFINITION]"
- +12 ;
- +13 ;Edit extract definition 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.2,DA)
- if CS2=CS1
- QUIT
- if +CS2=0
- QUIT
- +21 DO SEHIST^PXRMUTIL(810.2,DIC,DA)
- End DoDot:1
- +22 ;
- +23 SET VALMBCK="R"
- +24 QUIT
- +25 ;
- EPEDIT ;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.2,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.2,DA)
- +2 QUIT