PXRMEFED ; SLC/PJH - Extract Counting Editor ;01/28/2013
;;2.0;CLINICAL REMINDERS;**4,26**;Feb 04, 2005;Build 404
;
;Main entry point for PXRM COUNTING RULE 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 COUNT RULE EDIT")
Q
;
BLDLIST(IEN) ;Build workfile
N FLDS,GBL,PXRMROOT
S FLDS="[PXRM EXTRACT COUNTING]"
S GBL="^TMP(""PXRMEFED"",$J)"
S GBL=$NA(@GBL)
S PXRMROOT="^PXRM(810.7,"
K ^TMP("PXRMEFED",$J)
D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
S VALMCNT=$O(^TMP("PXRMEFED",$J,""),-1)
Q
;
ENTRY ;Entry code
D BLDLIST(IEN)
Q
;
EXIT ;Exit code
K ^TMP("PXRMEFED",$J)
K ^TMP("PXRMEFEDH",$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="PXRMEFEDH"
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 COUNTING RULE",DONE=0
W IORESET,!
F D Q:$D(DTOUT) Q:DONE
.S DIC="^PXRM(810.7,"
.;Set the starting place for additions.
.D SETSTART^PXRMCOPY(DIC)
.S DIC(0)="AELMQ",DLAYGO=810.7
.S DIC("A")="Select EXTRACT COUNTING RULE 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 rule already exists" Q
.S DA=$P(Y,U,1)
.;Edit Extract Counting Rule
.D EDIT(DA)
.S:$D(DA) DONE=1
Q
;
EDIT(DA) ;Edit Rule
I '$$VEDIT^PXRMUTIL("^PXRM(810.7,",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.7,DA)
;
S DIE="^PXRM(810.7,",DIDEL=810.7,ODA=DA,DR="[PXRM EXTRACT COUNTING]"
;
;Edit extract counting rule then unlock
D ^DIE,UNLOCK(ODA)
;Deleted ???
I '$D(DA) S VALMBCK="Q" Q
;
;Update edit history
D
.S CS2=$$FILE^PXRMEXCS(810.7,DA) Q:CS2=CS1 Q:+CS2=0
.D SEHIST^PXRMUTIL(810.7,DIC,DA)
;
S VALMBCK="R"
Q
;
EFEDIT ;Edit Rule
D EDIT(IEN) Q:VALMBCK="Q"
;
;Rebuild Workfile
D BLDLIST(IEN)
Q
;
EFGRP ;Counting Groups
D START^PXRMEGM(IEN)
;
;Rebiuld Workfile
D BLDLIST(IEN)
;
S VALMBCK="R"
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 ---[H[J[2J[HPXRMEFED 2786 printed Dec 13, 2024@01:44:26 Page 2
PXRMEFED ; SLC/PJH - Extract Counting Editor ;01/28/2013
+1 ;;2.0;CLINICAL REMINDERS;**4,26**;Feb 04, 2005;Build 404
+2 ;
+3 ;Main entry point for PXRM COUNTING RULE 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 COUNT RULE EDIT")
+6 QUIT
+7 ;
BLDLIST(IEN) ;Build workfile
+1 NEW FLDS,GBL,PXRMROOT
+2 SET FLDS="[PXRM EXTRACT COUNTING]"
+3 SET GBL="^TMP(""PXRMEFED"",$J)"
+4 SET GBL=$NAME(@GBL)
+5 SET PXRMROOT="^PXRM(810.7,"
+6 KILL ^TMP("PXRMEFED",$JOB)
+7 DO DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
+8 SET VALMCNT=$ORDER(^TMP("PXRMEFED",$JOB,""),-1)
+9 QUIT
+10 ;
ENTRY ;Entry code
+1 DO BLDLIST(IEN)
+2 QUIT
+3 ;
EXIT ;Exit code
+1 KILL ^TMP("PXRMEFED",$JOB)
+2 KILL ^TMP("PXRMEFEDH",$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="PXRMEFEDH"
+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 COUNTING RULE"
SET DONE=0
+3 WRITE IORESET,!
+4 FOR
Begin DoDot:1
+5 SET DIC="^PXRM(810.7,"
+6 ;Set the starting place for additions.
+7 DO SETSTART^PXRMCOPY(DIC)
+8 SET DIC(0)="AELMQ"
SET DLAYGO=810.7
+9 SET DIC("A")="Select EXTRACT COUNTING RULE 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 rule already exists"
QUIT
+15 SET DA=$PIECE(Y,U,1)
+16 ;Edit Extract Counting Rule
+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.7,",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.7,DA)
+10 ;
+11 SET DIE="^PXRM(810.7,"
SET DIDEL=810.7
SET ODA=DA
SET DR="[PXRM EXTRACT COUNTING]"
+12 ;
+13 ;Edit extract counting rule 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.7,DA)
if CS2=CS1
QUIT
if +CS2=0
QUIT
+21 DO SEHIST^PXRMUTIL(810.7,DIC,DA)
End DoDot:1
+22 ;
+23 SET VALMBCK="R"
+24 QUIT
+25 ;
EFEDIT ;Edit Rule
+1 DO EDIT(IEN)
if VALMBCK="Q"
QUIT
+2 ;
+3 ;Rebuild Workfile
+4 DO BLDLIST(IEN)
+5 QUIT
+6 ;
EFGRP ;Counting Groups
+1 DO START^PXRMEGM(IEN)
+2 ;
+3 ;Rebiuld Workfile
+4 DO BLDLIST(IEN)
+5 ;
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
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
