Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOSPMA3

PSOSPMA3.m

Go to the documentation of this file.
  1. PSOSPMA3 ;BIRM/MFR - ASAP Definitions Listman Actions Handler ;11/11/15
  1. ;;7.0;OUTPATIENT PHARMACY;**451,625**;DEC 1997;Build 42
  1. ;
  1. SHOWHID ; Handles Show/Hide Details
  1. ; (PSOSHOW: 1: Show Segment Tree only; 2: Show Segments & Data Elements; 3: Show Data Element Details)
  1. S VALMBCK="R"
  1. I PSOASVER="1995" D Q
  1. . S VALMSG="Details not available for ASAP 1995 version" W $C(7)
  1. W ?52,"Please wait..." S PSOSHOW=(($G(PSOSHOW)+1)#3)
  1. D INIT^PSOSPML3,HDR^PSOSPML3 I PSOSHOW=0 S VALMBG=1
  1. Q
  1. ;
  1. COPYVER ; Handles 'Copy ASAP Version' Action
  1. N NEWASVER,DIR,DIRUT,DTOUT,Y,X,VERS,DEFTYPE
  1. I PSOASVER="1995" S VALMSG="ASAP 1995 Version cannot be copied" W $C(7) G EXIT
  1. I '$$SECKEY() G EXIT
  1. I '$$LOCK() G EXIT
  1. D FULL^VALM1
  1. I PSOASVER="1995" D G BACK
  1. . S VALMSG="ASAP 1995 Version cannot be copied" W $C(7)
  1. CV ; Loop Prompt
  1. W !!," From ASAP Version: ",PSOASVER,!
  1. S DIR(0)="58.4001,.01",DIR("A")=" To ASAP Version" D ^DIR I $D(DIRUT)!$D(DTOUT) G BACK
  1. D VERLIST^PSOSPMU0("A","B",.VERS) ;adding "B" for Zero Report
  1. I $D(VERS(Y_" ")) W !!?3,"ASAP Version '",Y,"' already exists.",$C(7) G CV
  1. S NEWASVER=Y
  1. S X="",DEFTYPE="B"
  1. I $G(VERS(PSOASVER_" "))="C" D I X="^" G BACK
  1. . W ! S X=$$ASKFLD("Y","YES","Copy Customizations") I X="^" Q
  1. . S DEFTYPE=$S(X=1:"B",1:"S")
  1. W ! S X=$$ASKFLD("Y","NO","Confirm Copy") I X'=1 G BACK
  1. W ?40,"Copying..." D CLONEVER^PSOSPMU3(PSOASVER,NEWASVER,DEFTYPE) H 1 W "Done.",$C(7)
  1. S PSOASVER=NEWASVER
  1. G BACK
  1. ;
  1. EDTDELIM ; Handles the 'Edit Delimiters' Action
  1. N ELMDELIM,SEGDELIM,EOSCHR,X,DONE
  1. I PSOASVER="1995" S VALMSG="Delimiters cannot be changed for ASAP 1995 Version" W $C(7) G EXIT
  1. I '$$SECKEY() G EXIT
  1. I '$$LOCK() G EXIT
  1. D FULL^VALM1
  1. W !!,"ASAP Version ",PSOASVER," delimiters: ",!
  1. D LOADASAP^PSOSPMU0(PSOASVER,"B",.ALLASAP) ; Both ASAP Definitions
  1. ; Data Element Delimiter
  1. S DONE=0,ELMDELIM=$P($G(ALLASAP),"^",2)
  1. F S X=$$ASKFLD("58.4001,.02",ELMDELIM) Q:X="^" D I DONE Q
  1. . S ELMDELIM=$S(X="@":"",1:X) I X="@" W ?50,"Deleted." Q
  1. . S DONE=1
  1. ; Segment Terminator
  1. S DONE=0,SEGDELIM=$P($G(ALLASAP),"^",3)
  1. F S X=$$ASKFLD("58.4001,.03",SEGDELIM) Q:X="^" D I DONE Q
  1. . S SEGDELIM=$S(X="@":"",1:X) I X="@" W ?50,"Deleted." Q
  1. . S DONE=1
  1. I X="^" G BACK
  1. ; End-Of-Segment
  1. S DONE=0,EOSCHR=$P($G(ALLASAP),"^",4)
  1. F S X=$$ASKFLD("58.4001,.04",EOSCHR) Q:X="^" D I DONE Q
  1. . I X'="",X'="@",$$UP^XLFSTR(X)'?1"$C("1.3N.(1","1.3N)1")" D Q
  1. . . W !,"Invalid format. Use $C to specify a character escape sequence.",$C(7),!
  1. . S EOSCHR=$S(X="@":"",1:X) I X="@" W ?50,"Deleted." Q
  1. . S DONE=1
  1. I X="^" G BACK
  1. ; No changes
  1. I $P($G(ALLASAP),"^",2,4)=(ELMDELIM_"^"_SEGDELIM_"^"_EOSCHR) G BACK
  1. ;
  1. W ! S X=$$ASKFLD("Y","YES","Save Changes") I X'=1 G BACK
  1. W ?40,"Saving..."
  1. S $P(ALLASAP,"^",2,4)=ELMDELIM_"^"_SEGDELIM_"^"_EOSCHR
  1. D SAVEVER^PSOSPMU3(PSOASVER,ALLASAP)
  1. H 1 W "OK",$C(7)
  1. G BACK
  1. ;
  1. CUSSEG ; Handles the 'Customize Segment' Action
  1. N CUSSEG,DIR,DIRUT,DTOUT,X,Y,STDASAP,CUSASAP,ALLASAP,NEWSEG,DONE,QUIT,SEG,OK,SEGREQ,SEGPOS,PARSEG
  1. N HLPTXT,CUSSEGS,CNT,LITERAL
  1. I PSOASVER="1995" S VALMSG="ASAP 1995 Version cannot be customized" W $C(7) G EXIT
  1. I '$$SECKEY() G EXIT
  1. I '$$LOCK() G EXIT
  1. D FULL^VALM1
  1. ;
  1. CSL ; Loop Re-Prompt
  1. D LOADASAP^PSOSPMU0(PSOASVER,"S",.STDASAP) ; Standard ASAP Definition
  1. D LOADASAP^PSOSPMU0(PSOASVER,"C",.CUSASAP) ; Custom ASAP Definition
  1. D LOADASAP^PSOSPMU0(PSOASVER,"B",.ALLASAP) ; Both ASAP Definitions
  1. ;
  1. CSE ; Error Re-Prompt
  1. K DIR S HLPTXT="Enter the ASAP Segment ID that you want to customize (e.g.,'AIR')."
  1. I $G(STDASAP)'="" D
  1. . S SEG="999" F S SEG=$O(CUSASAP(SEG)) Q:SEG="" D
  1. . . I $$CUSSEG^PSOSPMU3(PSOASVER,SEG) S CUSSEGS(SEG)=$P(CUSASAP(SEG),"^",2)
  1. I '$D(CUSSEGS) D
  1. . S DIR("?")=HLPTXT
  1. E D
  1. . S DIR("?",1)=HLPTXT,(DIR("?"),DIR("?",2))=" "
  1. . S SEG="",CNT=3 F S SEG=$O(CUSSEGS(SEG)) Q:SEG="" D
  1. . . I $O(CUSSEGS(SEG))="" S DIR("?")=SEG_" "_$P(CUSSEGS(SEG),"^") Q
  1. . . S DIR("?",CNT)=SEG_" "_$P(CUSSEGS(SEG),"^"),CNT=CNT+1
  1. S DIR(0)="FO^1:5",DIR("A")="SEGMENT ID"
  1. W ! D ^DIR I $D(DIRUT)!$D(DTOUT)!(X="") G BACK
  1. S LITERAL=0 I $E(X)="""",$E(X,$L(X))="""" S X=$E(X,2,$L(X)-1),LITERAL=1
  1. I (X'?.AN)!($E(X,$L(X))?1N)!(X[" ") W !,"Invalid Segment ID.",$C(7) G CSE
  1. I 'LITERAL,'$D(ALLASAP(X)),$D(ALLASAP($$UP^XLFSTR(X))) S X=$$UP^XLFSTR(X)
  1. S CUSSEG=X W " ",$P($G(ALLASAP(CUSSEG)),"^",2) W !
  1. I $D(STDASAP(CUSSEG)) D
  1. . ; Segment Requirement
  1. . S X=$$ASKFLD("58.40011,.04",$P($G(ALLASAP(CUSSEG)),"^",4)) I X="^" Q
  1. . S SEGREQ=X
  1. . W ! S X=$$ASKFLD("Y","YES","Save Custom Segment") I X'=1 Q
  1. . W ?40,"Saving..."
  1. . ; If first time the Segment is being customized, copy; otherwise save
  1. . I '$D(CUSASAP(CUSSEG)) D
  1. . . S $P(STDASAP(CUSSEG),"^",4)=SEGREQ
  1. . . D COPYSEG^PSOSPMU3(PSOASVER,.STDASAP,PSOASVER,CUSSEG)
  1. . E D
  1. . . S $P(CUSASAP(CUSSEG),"^",4)=SEGREQ
  1. . . D SAVESEG^PSOSPMU3(PSOASVER,CUSSEG,CUSASAP(CUSSEG),ALLASAP)
  1. . W "OK",$C(7)
  1. E D
  1. . S (Y,NEWSEG)=0
  1. . I '$D(CUSASAP(CUSSEG)) D I $D(DIRUT)!$D(DTOUT)!'Y Q
  1. . . K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you adding '"_CUSSEG_"' as a new SEGMENT ID" W $C(7) D ^DIR
  1. . . S NEWSEG=1 W !
  1. . S $P(CUSASAP(CUSSEG),"^",1)=CUSSEG
  1. . ; Segment Name
  1. . S X=$$ASKFLD("58.40011,.02",$P(CUSASAP(CUSSEG),"^",2)) I X="^" Q
  1. . S $P(CUSASAP(CUSSEG),"^",2)=X
  1. . ; Parent Segment
  1. . S DONE=0
  1. . F S X=$$ASKFLD("58.40011,.03",$P(CUSASAP(CUSSEG),"^",3)) Q:X="^"!(X="") D I DONE Q
  1. . . I X="@" S $P(CUSASAP(CUSSEG),"^",3)="" Q
  1. . . I '$D(ALLASAP(X)),$D(ALLASAP($$UP^XLFSTR(X))) S X=$$UP^XLFSTR(X)
  1. . . I '$D(ALLASAP(X)) W !,"Parent Segment ID not found.",$C(7) Q
  1. . . I X=CUSSEG W !,"Parent Segment ID cannot be its own parent.",$C(7) Q
  1. . . W " ",$P(ALLASAP(X),"^",2)
  1. . . S $P(CUSASAP(CUSSEG),"^",3)=X,DONE=1
  1. . I X="^" Q
  1. . ; Segment Requirement
  1. . S X=$$ASKFLD("58.40011,.04",$P(CUSASAP(CUSSEG),"^",4)) I X="^" Q
  1. . S $P(CUSASAP(CUSSEG),"^",4)=X
  1. . S DONE=0
  1. . F S X=$$ASKFLD("58.40011,.05",$P(CUSASAP(CUSSEG),"^",5)) Q:X="^" D I DONE Q
  1. . . S SEG="999",OK=1 F S SEG=$O(ALLASAP(SEG)) Q:SEG="" D I 'OK Q
  1. . . . I SEG'=CUSSEG,$P(ALLASAP(SEG),"^",3)=$P(CUSASAP(CUSSEG),"^",3),$P(ALLASAP(SEG),"^",5)=X D
  1. . . . . S OK=0 W !,"The Segment '",SEG,"' (",$P(ALLASAP(SEG),"^",2),") already occupies this position.",$C(7) Q
  1. . . I OK S $P(CUSASAP(CUSSEG),"^",5)=X,DONE=1
  1. . I X="^" Q
  1. . ; Segment Level
  1. . S DONE=0,PARSEG=$P(CUSASAP(CUSSEG),"^",3)
  1. . I PARSEG'="",$P(CUSASAP(CUSSEG),"^",6)="",$P($G(ALLASAP(PARSEG)),"^",6)>3 D
  1. . . S $P(CUSASAP(CUSSEG),"^",6)=$P($G(ALLASAP(PARSEG)),"^",6)
  1. . F S X=$$ASKFLD("58.40011,.06",$P(CUSASAP(CUSSEG),"^",6)) Q:X="^" D I DONE Q
  1. . . I $P(CUSASAP(CUSSEG),"^",3)="",X'=1,X'=6 D Q
  1. . . . W !,"Orphan segments can only be located at the MAIN HEADER or MAIN TRAILER levels.",$C(7)
  1. . . S QUIT=0
  1. . . I PARSEG'="" D I QUIT Q
  1. . . . I $P($G(ALLASAP(PARSEG)),"^",6)>3,X'=$P($G(ALLASAP(PARSEG)),"^",6) D S QUIT=1 Q
  1. . . . . W !,"Segment level must be the same as the parent's level (",$P($G(ALLASAP(PARSEG)),"^",6),").",$C(7)
  1. . . . I X<$P($G(ALLASAP(PARSEG)),"^",6) D S QUIT=1 Q
  1. . . . . W !,"Segment level cannot be lower than parent's level (",$P($G(ALLASAP(PARSEG)),"^",6),").",$C(7)
  1. . . . I X>($P($G(ALLASAP(PARSEG)),"^",6)+1) D S QUIT=1 Q
  1. . . . . W !,"Segment level cannot be more than 1 level above parent's level (",$P($G(ALLASAP(PARSEG)),"^",6),").",$C(7)
  1. . . S $P(CUSASAP(CUSSEG),"^",6)=X,DONE=1
  1. . I X="^" Q
  1. . ; Confirm
  1. . W ! S X=$$ASKFLD("Y","YES","Save Custom Segment") I X'=1 Q
  1. . W ?40,"Saving..."
  1. . D SAVESEG^PSOSPMU3(PSOASVER,$S(NEWSEG:"+1",1:CUSSEG),CUSASAP(CUSSEG),ALLASAP)
  1. . H 1 W "OK",$C(7)
  1. G CSL
  1. ;
  1. CUSELM ; Handles the 'Customize Element' Action
  1. N CUSELM,DIR,DIRUT,DTOUT,X,Y,STDASAP,CUSASAP,SEGID,ELMPOS,MAXLEN,ELMREQ,NEWELM,ELMDATA
  1. N DIC,DWPK,I,MEXPR,LINE,HLPTXT,CUSELMS,CNT,ELM
  1. I PSOASVER="1995" S VALMSG="ASAP 1995 Version cannot be customized" W $C(7) G EXIT
  1. I '$$SECKEY() G EXIT
  1. I '$$LOCK() G EXIT
  1. D FULL^VALM1
  1. ;
  1. CEL ; Loop Re-Prompt
  1. D LOADASAP^PSOSPMU0(PSOASVER,"S",.STDASAP) ; Standard ASAP Definition
  1. D LOADASAP^PSOSPMU0(PSOASVER,"C",.CUSASAP) ; Custom ASAP Definition
  1. D LOADASAP^PSOSPMU0(PSOASVER,"B",.ALLASAP) ; Both ASAP Definitions
  1. ;
  1. CEE ; Error Re-Prompt
  1. K DIR S HLPTXT="Enter the ASAP Data Element ID that you want to customize (e.g.,'PAT03')"
  1. I $G(STDASAP)'="" D
  1. . S SEG="999" F S SEG=$O(CUSASAP(SEG)) Q:SEG="" D
  1. . . S ELM=0 F S ELM=$O(CUSASAP(SEG,ELM)) Q:'ELM D
  1. . . . S CUSELMS($P(CUSASAP(SEG,ELM),"^"))=$P(CUSASAP(SEG,ELM),"^",2)
  1. I '$D(CUSELMS) D
  1. . S DIR("?")=HLPTXT
  1. E D
  1. . S DIR("?",1)=HLPTXT,(DIR("?"),DIR("?",2))=" "
  1. . S CNT=2,ELM="" F S ELM=$O(CUSELMS(ELM)) Q:ELM="" D
  1. . . I $O(CUSELMS(ELM))="" S DIR("?")=ELM_" "_$P(CUSELMS(ELM),"^") Q
  1. . . S DIR("?",CNT)=ELM_" "_$P(CUSELMS(ELM),"^"),CNT=CNT+1
  1. S DIR(0)="FO^1:10",DIR("A")="DATA ELEMENT ID"
  1. W ! D ^DIR I $D(DIRUT)!$D(DTOUT)!(X="") G BACK
  1. S SEGID=$$GETSEGID^PSOSPMU3(X) I SEGID=""!(X[" ") W !,"Invalid Segment.",$C(7) G CEE
  1. I '$D(ALLASAP(SEGID)),$D(ALLASAP($$UP^XLFSTR(SEGID))) D
  1. . S X=$$UP^XLFSTR(X),SEGID=$$UP^XLFSTR(SEGID)
  1. I '$D(ALLASAP(SEGID)) W !!,"Segment ID '",SEGID,"' not found.",$C(7) G CEE
  1. S ELMPOS=$P(X,SEGID,2) I 'ELMPOS!(ELMPOS'?2N) W !,"Invalid Data Element position (",ELMPOS,").",$C(7) G CEE
  1. W " ",$P($G(ALLASAP(SEGID,+ELMPOS)),"^",2) W !
  1. S CUSELM=X
  1. I ELMPOS>1,'$D(ALLASAP(SEGID,ELMPOS-1)) D G CEE
  1. . W !,"Invalid Data Element position (",ELMPOS,"). Next Data Element must be ",SEGID,$E(100+$O(ALLASAP(SEGID,99),-1)+1,2,3),".",$C(7)
  1. ;
  1. S ELMPOS=+ELMPOS
  1. I $D(STDASAP(SEGID,ELMPOS)) D
  1. . ; Data Element Maximum Length
  1. . S X=$$ASKFLD("58.400111,.04",$P($G(ALLASAP(SEGID,ELMPOS)),"^",4)) I X="^" Q
  1. . S MAXLEN=X
  1. . ; Data Element Requirement
  1. . S X=$$ASKFLD("58.400111,.06",$P($G(ALLASAP(SEGID,ELMPOS)),"^",6)) I X="^" Q
  1. . S ELMREQ=X
  1. . ; Data Element M Expression
  1. . S MEXPR="" F I=1:1 Q:'$D(ALLASAP(SEGID,ELMPOS,"VAL",I)) D
  1. . . S MEXPR=MEXPR_ALLASAP(SEGID,ELMPOS,"VAL",I)
  1. . S X=$$ASKMEXPR($P(ALLASAP(SEGID),"^",6),CUSELM,MAXLEN,MEXPR) I X="^" Q
  1. . S MEXPR=X
  1. . W ! S X=$$ASKFLD("Y","YES","Save Custom Data Element") I X'=1 Q
  1. . W ?40,"Saving..."
  1. . ; If first time the Data Element is being customized, copy; otherwise save
  1. . I '$D(CUSASAP(SEGID,ELMPOS)) D
  1. . . ; The Custom ASAP Segment node might not be present (1st time), therefore it must be created
  1. . . I '$D(CUSASAP(SEGID)) D COPYSEG^PSOSPMU3(PSOASVER,.STDASAP,PSOASVER,SEGID)
  1. . . S $P(STDASAP(SEGID,ELMPOS),"^",4)=MAXLEN
  1. . . S $P(STDASAP(SEGID,ELMPOS),"^",6)=ELMREQ
  1. . . S STDASAP(SEGID,ELMPOS,"VAL",1)=MEXPR
  1. . . D COPYELM^PSOSPMU3(PSOASVER,.STDASAP,PSOASVER,CUSELM)
  1. . E D
  1. . . S $P(CUSASAP(SEGID,ELMPOS),"^",4)=MAXLEN
  1. . . S $P(CUSASAP(SEGID,ELMPOS),"^",6)=ELMREQ
  1. . . S CUSASAP(SEGID,ELMPOS,"VAL",1)=MEXPR
  1. . . K ELMDATA M ELMDATA=CUSASAP(SEGID,ELMPOS)
  1. . . D SAVEELM^PSOSPMU3(PSOASVER,SEGID,CUSELM,.ELMDATA)
  1. . W "OK",$C(7)
  1. E D
  1. . K ELMDATA S (Y,NEWELM)=0
  1. . I '$D(CUSASAP(SEGID,ELMPOS)) D I $D(DIRUT)!$D(DTOUT)!'Y Q
  1. . . K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you adding '"_CUSELM_"' as a new DATA ELEMENT" W $C(7) D ^DIR
  1. . . S NEWELM=1 W !
  1. . ; Data Element ID and Position are non-editable fields
  1. . S $P(ELMDATA,"^",1)=CUSELM
  1. . S $P(ELMDATA,"^",5)=ELMPOS
  1. . ; Data Element Name
  1. . S X=$$ASKFLD("58.400111,.02",$P($G(CUSASAP(SEGID,ELMPOS)),"^",2)) I X="^" Q
  1. . S $P(ELMDATA,"^",2)=X
  1. . ; Data Element Format
  1. . S X=$$ASKFLD("58.400111,.03",$P($G(CUSASAP(SEGID,ELMPOS)),"^",3)) I X="^" Q
  1. . S $P(ELMDATA,"^",3)=X
  1. . ; Data Element Maximum Length
  1. . S X=$$ASKFLD("58.400111,.04",$P($G(CUSASAP(SEGID,ELMPOS)),"^",4)) I X="^" Q
  1. . S $P(ELMDATA,"^",4)=X
  1. . ; Data Element Requirement
  1. . S X=$$ASKFLD("58.400111,.06",$P($G(CUSASAP(SEGID,ELMPOS)),"^",6)) I X="^" Q
  1. . S $P(ELMDATA,"^",6)=X
  1. . ; Data Element Description
  1. . W !,"DESCRIPTION:" K ^TMP("PSOASDES",$J)
  1. . ; Transferring Description from Local Array ALLASAP to ^TMP($J)
  1. . F I=1:1 Q:'$D(ALLASAP(SEGID,ELMPOS,"DES",I)) D
  1. . . S ^TMP("PSOASDES",$J,I,0)=ALLASAP(SEGID,ELMPOS,"DES",I)
  1. . K DIC S DWPK=1,DIC="^TMP(""PSOASDES"","_$J_"," D EN^DIWE
  1. . ; Transferring Description from ^TMP($J) to Local Array CUSASAP
  1. . F I=1:1 Q:'$D(^TMP("PSOASDES",$J,I,0)) D
  1. . . S ELMDATA("DES",I)=^TMP("PSOASDES",$J,I,0)
  1. . ; Data Element M Expression
  1. . S DONE=0,MEXPR=""
  1. . F I=1:1 Q:'$D(ALLASAP(SEGID,ELMPOS,"VAL",I)) D
  1. . . S MEXPR=MEXPR_ALLASAP(SEGID,ELMPOS,"VAL",I)
  1. . S X=$$ASKMEXPR($P(ALLASAP(SEGID),"^",6),CUSELM,$P(ELMDATA,"^",4),MEXPR) I X="^" Q
  1. . S ELMDATA("VAL",1)=X
  1. . ; Confirm
  1. . W ! S X=$$ASKFLD("Y","YES","Save Custom Data Element") I X'=1 Q
  1. . W ?40,"Saving..."
  1. . ; The Custom ASAP Segment node might not be present, therefore it must be created
  1. . I $G(CUSASAP(SEGID))="" D COPYSEG^PSOSPMU3(PSOASVER,.STDASAP,PSOASVER,SEGID)
  1. . D SAVEELM^PSOSPMU3(PSOASVER,SEGID,$S(NEWELM:"+1",1:CUSELM),.ELMDATA)
  1. . W "OK",$C(7)
  1. G CEL
  1. ;
  1. ASKFLD(FIELD,DEFAULT,PROMPT) ; Prompt
  1. ;Input: (r) FIELD - DD Field reference (e.g., "58.40011;.02") for ^DIR call
  1. ; (o) DEFAULT - Default value
  1. ; (o) PROMPT - Alternative prompt label
  1. ;Output: User entered value or "^"
  1. N ASKFLD,DIR,DTOUT,DIRUT,X,Y,DONE
  1. S ASKFLD="",DIR(0)=FIELD S:$G(DEFAULT)'="" DIR("B")=DEFAULT S:$G(PROMPT)'="" DIR("A")=PROMPT
  1. S DONE=0 F D ^DIR D I DONE Q
  1. . I X["^",$L(X)>1 W !,"Jumping is not supported. Enter '^' to exit.",$C(7) Q
  1. . I X="@" S ASKFLD=X,DONE=1 Q
  1. . I (X'=""),$D(DIRUT)!$D(DTOUT) S DONE=1 Q
  1. . S ASKFLD=Y,DONE=1
  1. I X'="",X'="@",$D(DIRUT)!$D(DTOUT) S ASKFLD="^"
  1. Q ASKFLD
  1. ;
  1. ASKMEXPR(LEVEL,ELMID,MAXLEN,DEFAULT) ; Prompt for M SET Expression
  1. ;Input: (r) LEVEL - Level of the Segment where the Data Element is located
  1. ; (r) ELMID - Data Element ID ("PHA01", "DSP02", etc.)
  1. ; (r) MAXLEN - Element ID value Maximum Length
  1. ; (o) DEFAULT - Default value
  1. ;Output: M SET Expression or "^"
  1. N ASKMEXPR,DONE,ERROR
  1. S DONE=0,X=$G(DEFAULT)
  1. F D I DONE Q
  1. . S X=$G(DEFAULT) W !,"M SET EXPRESSION: "_$S(X'="":X_"// ",1:"")
  1. . R X:DTIME S:X="" X=$G(DEFAULT) I '$T!(X="^") S ASKMEXPR="^",DONE=1 Q
  1. . I X["?" W ! D MEXPRHLP^PSOSPML3(LEVEL,ELMID) W ! Q
  1. . I '$$VALID^PSOSPMU3(PSOASVER,X) W !,$P($$VALID^PSOSPMU3(PSOASVER,X),"^",2),$C(7),! Q
  1. . I '$$CHKVAR^PSOSPMU3(LEVEL,X) Q
  1. . D CHKCODE^PSOSPMU3(LEVEL,X,.ERROR) I ERROR Q
  1. . I $E(X,1)="""",$E(X,$L(X))="""",$E(X,2,$L(X)-1)'["""",$L(X)-2>MAXLEN D Q
  1. . . W !,"The length cannot be longer than the maximum (",MAXLEN,").",$C(7),!
  1. . S ASKMEXPR=X,DONE=1
  1. Q ASKMEXPR
  1. ;
  1. SECKEY() ; Checking the Security Key PSO SPMP ADMIN for certain actions
  1. I '$D(^XUSEC("PSO SPMP ADMIN",DUZ)) S VALMSG="PSO SPMP ADMIN key required for this action!" W $C(7) Q 0
  1. Q 1
  1. ;
  1. LOCK() ; Try to LOCK the SPMP ASAP RECORD DEFINITION file (#58.4)
  1. L +^PS(58.4):0 I '$T D Q 0
  1. . S VALMSG="Another user is editing the ASAP Definitions" W $C(7)
  1. Q 1
  1. ;
  1. BACK ; Unlock ASAP Definition File Go Back to the list
  1. L -^PS(58.4)
  1. D INIT^PSOSPML3,HDR^PSOSPML3 I 'VALMCNT Q
  1. EXIT ; Exit without rebuilding the list
  1. S VALMBCK="R"
  1. Q