- PSOSPMB3 ;BIRM/MFR - ASAP Definitions Listman Actions Handler (Cont.) ;11/11/15
- ;;7.0;OUTPATIENT PHARMACY;**451**;DEC 1997;Build 114
- ;
- DELCUS ; Handles the 'Delete Customizatoin' Action
- N CUSTYPE,DIR,DTOUT,DIRUT,VERLST,X,Y,STDASAP,CUSASAP,SEGID,ELMID,ELMPOS,SEG,ELM,DONE,STOP,I,J
- N CNT,CHILDREN,STDVDLMS,ALLVDLMS
- I PSOASVER="1995" S VALMSG="ASAP 1995 Version cannot be customized" W $C(7) G EXIT^PSOSPMA3
- I '$$SECKEY^PSOSPMA3() G EXIT^PSOSPMA3
- I '$$LOCK^PSOSPMA3() G EXIT^PSOSPMA3
- S CUSTYPE=0
- D FULL^VALM1
- K DIR S DIR("A")="Customization Selection",DIR(0)="SO^"
- S STDVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"S"),ALLVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"B")
- I STDVDLMS'="",STDVDLMS'=ALLVDLMS D
- . S DIR(0)=DIR(0)_"D:ASAP "_PSOASVER_" Delimiters (Restore);"
- S DIR(0)=DIR(0)_"V:ASAP "_PSOASVER_" Version;S:ASAP "_PSOASVER_" Segment;E:ASAP "_PSOASVER_" Data Element"
- S DIR("?")="Select the customization to be deleted."
- D ^DIR I (X="")!$D(DIRUT)!$D(DTOUT) G BACK^PSOSPMA3
- S CUSTYPE=Y
- ;
- ; Restore ASAP Version Delimiters
- I CUSTYPE="D" D G BACK^PSOSPMA3
- . W !!,"The customization for the ASAP Version '",PSOASVER,"' delimiters will be deleted and the"
- . W !,"standard delimiters will be restored to the following:",!
- . W:$P(STDVDLMS,"^",2)'=$P(ALLVDLMS,"^",2) !?3,"Element Delimiter ('",$P(STDVDLMS,"^",2),"')"
- . W:$P(STDVDLMS,"^",3)'=$P(ALLVDLMS,"^",3) !?3,"Segment Terminator ('",$P(STDVDLMS,"^",3),"')"
- . W:$P(STDVDLMS,"^",4)'=$P(ALLVDLMS,"^",4) !?3,"End Of Line Escape (",$S($P(STDVDLMS,"^",4)="":"<NULL>",1:"'"_$P(STDVDLMS,"^",4)_"'"),")"
- . W ! S X=$$ASKFLD^PSOSPMA3("Y","NO","Confirm Deletion") I X'=1 Q
- . W ?40,"Restoring..." D SAVEVER^PSOSPMU3(PSOASVER,$$VERDATA^PSOSPMU0(PSOASVER,"S")) H 1 W "OK",$C(7)
- ;
- ; Delete ASAP Version
- I CUSTYPE="V" D G BACK^PSOSPMA3
- . D LOADASAP^PSOSPMU0(PSOASVER,"S",.STDASAP) ; Standard ASAP Definition
- . D LOADASAP^PSOSPMU0(PSOASVER,"C",.CUSASAP) ; Custom ASAP Definition
- . I $G(STDASAP)="",$$VERINUSE(PSOASVER) D Q
- . . W !!,"ASAP Version ",PSOASVER," is being used by ",$$GET1^DIQ(5,$$VERINUSE(PSOASVER),.01)," and cannot be deleted.",$C(7)
- . . D PAUSE^PSOSPMU1
- . W !!," ASAP Version: ",PSOASVER
- . I $G(STDASAP)'="" D
- . . W !!,"The customization for the ASAP Version '",PSOASVER,"' and all of its custom Segments,"
- . . W !,"Data Elements and Delimiters will be deleted and the standard definition"
- . . W !,"will be restored.",!
- . E D
- . . W !!,"The custom ASAP Version '",PSOASVER,"' and all of its Segments and Data Elements"
- . . W !,"will be deleted.",!
- . I STDVDLMS'="" D
- . . W:$P(STDVDLMS,"^",2)'=$P(ALLVDLMS,"^",2) !?3,"Element Delimiter ('",$P(ALLVDLMS,"^",2),"')"
- . . W:$P(STDVDLMS,"^",3)'=$P(ALLVDLMS,"^",3) !?3,"Segment Terminator ('",$P(ALLVDLMS,"^",3),"')"
- . . W:$P(STDVDLMS,"^",4)'=$P(ALLVDLMS,"^",4) !?3,"End Of Line Escape (",$S($P(ALLVDLMS,"^",4)="":"<NULL>",1:"'"_$P(ALLVDLMS,"^",4)_"'"),")"
- . S (STOP,CNT)=3,SEG="999" F S SEG=$O(CUSASAP(SEG)) Q:SEG="" D I STOP="^" Q
- . . I $$CUSSEG^PSOSPMU3(PSOASVER,SEG) W !?3,$P(CUSASAP(SEG),"^",1),?12,$P(CUSASAP(SEG),"^",2) S CNT=CNT+1
- . . S ELM=0 F S ELM=$O(CUSASAP(SEG,ELM)) Q:'ELM D I STOP="^" Q
- . . . W !?3,$P(CUSASAP(SEG,ELM),"^",1),?12,$P(CUSASAP(SEG,ELM),"^",2) S CNT=CNT+1
- . . . I (CNT>22) S STOP=$$ASKFLD^PSOSPMA3("E",,"Enter <RET> to continue or '^' to STOP"),CNT=0
- . W ! S X=$$ASKFLD^PSOSPMA3("Y","NO","Confirm Deletion") I X'=1 Q
- . W ?40,"Deleting..." D DELCUS^PSOSPMU3(PSOASVER) H 1 W "OK",$C(7)
- ;
- ; Delete ASAP Segment
- I CUSTYPE="S" D G BACK^PSOSPMA3
- . D LOADASAP^PSOSPMU0(PSOASVER,"S",.STDASAP) ; Standard ASAP Definition
- . D LOADASAP^PSOSPMU0(PSOASVER,"C",.CUSASAP) ; Custom ASAP Definition
- . W !!,"ASAP Version ",PSOASVER
- . K DIR S DIR("?",1)="Enter the Custom ASAP Segment ID that you want to delete."
- . S DIR("?",2)=" ",DIR("?",3)=" Choose from:"
- . S (STOP,CNT)=0,SEG="999",CNT=4 F S SEG=$O(CUSASAP(SEG)) Q:SEG="" D
- . . S DIR("?",CNT)=" "_SEG_" "_$P(CUSASAP(SEG),"^",2),CNT=CNT+1
- . S DIR("?")=" ",DIR(0)="FO^1:5",DIR("A")="SEGMENT ID"
- . S SEGID="",DONE=0 F W ! D ^DIR Q:($D(DIRUT)!$D(DTOUT))!(X="") D I DONE Q
- . . S:'$D(CUSASAP(X)) X=$$UP^XLFSTR(X) I '$D(CUSASAP(X)) W !,"Custom Segment not found!",$C(7) Q
- . . K CHILDREN I '$D(STDASAP(X)) D I $O(CHILDREN(""))'="" Q
- . . . S SEG="999" F S SEG=$O(CUSASAP(SEG)) Q:SEG="" I $P(CUSASAP(SEG),"^",3)=X S CHILDREN(SEG)=""
- . . . I $O(CHILDREN(""))'="" D
- . . . . W !!,"The following custom children ASAP Segments must be deleted first:",!,$C(7)
- . . . . S SEG="" F S SEG=$O(CHILDREN(SEG)) Q:SEG="" W !?3,SEG,?12,$P(CUSASAP(SEG),"^",2)
- . . S SEGID=X W " ",$P(CUSASAP(SEGID),"^",2) S DONE=1
- . I 'DONE Q
- . I $D(STDASAP(SEGID)) D
- . . W !!,"The customization for the Segment '",SEGID,"' and all of its custom Data Elements"
- . . W !,"will be deleted and the standard definition will be restored.",!
- . E D
- . . W !!,"The custom Segment '",SEGID,"' and all of its Data Elements will be deleted.",!
- . S STOP="",(ELM,CNT)=0 F S ELM=$O(CUSASAP(SEGID,ELM)) Q:ELM="" D
- . . W !?3,$P(CUSASAP(SEGID,ELM),"^",1),?12,$P(CUSASAP(SEGID,ELM),"^",2) S CNT=CNT+1
- . . I (CNT>18) S STOP=$$ASKFLD^PSOSPMA3("E",,"Enter <RET> to continue or '^' to STOP"),CNT=0
- . W ! S X=$$ASKFLD^PSOSPMA3("Y","NO","Confirm Deletion") I X'=1 Q
- . W ?40,"Deleting..." D DELCUS^PSOSPMU3(PSOASVER,SEGID) H 1 W "OK",$C(7)
- ;
- ; Delete ASAP Data Element
- I CUSTYPE="E" D G BACK^PSOSPMA3
- . D LOADASAP^PSOSPMU0(PSOASVER,"S",.STDASAP) ; Standard ASAP Definition
- . D LOADASAP^PSOSPMU0(PSOASVER,"C",.CUSASAP) ; Custom ASAP Definition
- . W !!,"ASAP Version ",PSOASVER
- . K DIR S DIR("?",1)="Enter the Custom ASAP Data Element that you want to delete."
- . S DIR("?",2)=" ",DIR("?",3)=" Choose from:"
- . S SEG="999",CNT=4 F S SEG=$O(CUSASAP(SEG)) Q:SEG="" D
- . . S ELM=0 F S ELM=$O(CUSASAP(SEG,ELM)) Q:'ELM D
- . . . S DIR("?",CNT)=" "_$P(CUSASAP(SEG,ELM),"^")_" "_$P(CUSASAP(SEG,ELM),"^",2),CNT=CNT+1
- . S DIR("?")=" ",DIR(0)="FO^1:10",DIR("A")="DATA ELEMENT ID"
- . S DONE=0 F W ! D ^DIR Q:($D(DIRUT)!$D(DTOUT))!(X="") D I DONE Q
- . . I '$D(CUSASAP($$GETSEGID^PSOSPMU3(X))) S X=$$UP^XLFSTR(X)
- . . S SEGID=$$GETSEGID^PSOSPMU3(X),ELMPOS=+$P(X,SEGID,2)
- . . I '$D(CUSASAP(SEGID,ELMPOS)) W !,"Custom Data Element not found!",$C(7) Q
- . . I $D(CUSASAP(SEGID,ELMPOS+1)),'$D(STDASAP(SEGID,ELMPOS+1)) D Q
- . . . W !,"Only the last Custom Data Element in the Segment can be deleted.",$C(7)
- . . W " ",$P(CUSASAP(SEGID),"^",2) S DONE=1
- . I 'DONE Q
- . I $D(STDASAP(SEGID,ELMPOS)) D
- . . W !!,"The customization for the Data Element '",$P(STDASAP(SEGID,ELMPOS),"^"),"' will be deleted and the"
- . . W !,"standard definition will be restored.",!
- . E D
- . . W !!,"The custom Data Element '",$P(CUSASAP(SEGID,ELMPOS),"^",1),"' will be deleted.",!
- . S X=$$ASKFLD^PSOSPMA3("Y","NO","Confirm Deletion") I X'=1 Q
- . W ?40,"Deleting..." D DELCUS^PSOSPMU3(PSOASVER,SEGID,$P(CUSASAP(SEGID,ELMPOS),"^",1)) H 1 W "OK",$C(7)
- G BACK^PSOSPMA3
- ;
- VERINUSE(PSOASVER) ; Verify whether the ASAP Version is in use or not
- ; Input: (r) PSOASVER - Source ASAP Version to be cloned (3.0, 4.0, 4.1, 4.2)
- ;Output: $$VERINUSE - Pointer to first the STATE file (#5) that is using the ASAP Version
- N STATE,VERINUSE
- S (STATE,VERINUSE)=0 F S STATE=$O(^PS(58.41,STATE)) Q:'STATE D I VERINUSE Q
- . I $$GET1^DIQ(58.41,STATE,1,"I")=PSOASVER S VERINUSE=STATE
- Q VERINUSE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPMB3 7469 printed Mar 13, 2025@21:39:52 Page 2
- PSOSPMB3 ;BIRM/MFR - ASAP Definitions Listman Actions Handler (Cont.) ;11/11/15
- +1 ;;7.0;OUTPATIENT PHARMACY;**451**;DEC 1997;Build 114
- +2 ;
- DELCUS ; Handles the 'Delete Customizatoin' Action
- +1 NEW CUSTYPE,DIR,DTOUT,DIRUT,VERLST,X,Y,STDASAP,CUSASAP,SEGID,ELMID,ELMPOS,SEG,ELM,DONE,STOP,I,J
- +2 NEW CNT,CHILDREN,STDVDLMS,ALLVDLMS
- +3 IF PSOASVER="1995"
- SET VALMSG="ASAP 1995 Version cannot be customized"
- WRITE $CHAR(7)
- GOTO EXIT^PSOSPMA3
- +4 IF '$$SECKEY^PSOSPMA3()
- GOTO EXIT^PSOSPMA3
- +5 IF '$$LOCK^PSOSPMA3()
- GOTO EXIT^PSOSPMA3
- +6 SET CUSTYPE=0
- +7 DO FULL^VALM1
- +8 KILL DIR
- SET DIR("A")="Customization Selection"
- SET DIR(0)="SO^"
- +9 SET STDVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"S")
- SET ALLVDLMS=$$VERDATA^PSOSPMU0(PSOASVER,"B")
- +10 IF STDVDLMS'=""
- IF STDVDLMS'=ALLVDLMS
- Begin DoDot:1
- +11 SET DIR(0)=DIR(0)_"D:ASAP "_PSOASVER_" Delimiters (Restore);"
- End DoDot:1
- +12 SET DIR(0)=DIR(0)_"V:ASAP "_PSOASVER_" Version;S:ASAP "_PSOASVER_" Segment;E:ASAP "_PSOASVER_" Data Element"
- +13 SET DIR("?")="Select the customization to be deleted."
- +14 DO ^DIR
- IF (X="")!$DATA(DIRUT)!$DATA(DTOUT)
- GOTO BACK^PSOSPMA3
- +15 SET CUSTYPE=Y
- +16 ;
- +17 ; Restore ASAP Version Delimiters
- +18 IF CUSTYPE="D"
- Begin DoDot:1
- +19 WRITE !!,"The customization for the ASAP Version '",PSOASVER,"' delimiters will be deleted and the"
- +20 WRITE !,"standard delimiters will be restored to the following:",!
- +21 if $PIECE(STDVDLMS,"^",2)'=$PIECE(ALLVDLMS,"^",2)
- WRITE !?3,"Element Delimiter ('",$PIECE(STDVDLMS,"^",2),"')"
- +22 if $PIECE(STDVDLMS,"^",3)'=$PIECE(ALLVDLMS,"^",3)
- WRITE !?3,"Segment Terminator ('",$PIECE(STDVDLMS,"^",3),"')"
- +23 if $PIECE(STDVDLMS,"^",4)'=$PIECE(ALLVDLMS,"^",4)
- WRITE !?3,"End Of Line Escape (",$SELECT($PIECE(STDVDLMS,"^",4)="":"<NULL>",1:"'"_$PIECE(STDVDLMS,"^",4)_"'"),")"
- +24 WRITE !
- SET X=$$ASKFLD^PSOSPMA3("Y","NO","Confirm Deletion")
- IF X'=1
- QUIT
- +25 WRITE ?40,"Restoring..."
- DO SAVEVER^PSOSPMU3(PSOASVER,$$VERDATA^PSOSPMU0(PSOASVER,"S"))
- HANG 1
- WRITE "OK",$CHAR(7)
- End DoDot:1
- GOTO BACK^PSOSPMA3
- +26 ;
- +27 ; Delete ASAP Version
- +28 IF CUSTYPE="V"
- Begin DoDot:1
- +29 ; Standard ASAP Definition
- DO LOADASAP^PSOSPMU0(PSOASVER,"S",.STDASAP)
- +30 ; Custom ASAP Definition
- DO LOADASAP^PSOSPMU0(PSOASVER,"C",.CUSASAP)
- +31 IF $GET(STDASAP)=""
- IF $$VERINUSE(PSOASVER)
- Begin DoDot:2
- +32 WRITE !!,"ASAP Version ",PSOASVER," is being used by ",$$GET1^DIQ(5,$$VERINUSE(PSOASVER),.01)," and cannot be deleted.",$CHAR(7)
- +33 DO PAUSE^PSOSPMU1
- End DoDot:2
- QUIT
- +34 WRITE !!," ASAP Version: ",PSOASVER
- +35 IF $GET(STDASAP)'=""
- Begin DoDot:2
- +36 WRITE !!,"The customization for the ASAP Version '",PSOASVER,"' and all of its custom Segments,"
- +37 WRITE !,"Data Elements and Delimiters will be deleted and the standard definition"
- +38 WRITE !,"will be restored.",!
- End DoDot:2
- +39 IF '$TEST
- Begin DoDot:2
- +40 WRITE !!,"The custom ASAP Version '",PSOASVER,"' and all of its Segments and Data Elements"
- +41 WRITE !,"will be deleted.",!
- End DoDot:2
- +42 IF STDVDLMS'=""
- Begin DoDot:2
- +43 if $PIECE(STDVDLMS,"^",2)'=$PIECE(ALLVDLMS,"^",2)
- WRITE !?3,"Element Delimiter ('",$PIECE(ALLVDLMS,"^",2),"')"
- +44 if $PIECE(STDVDLMS,"^",3)'=$PIECE(ALLVDLMS,"^",3)
- WRITE !?3,"Segment Terminator ('",$PIECE(ALLVDLMS,"^",3),"')"
- +45 if $PIECE(STDVDLMS,"^",4)'=$PIECE(ALLVDLMS,"^",4)
- WRITE !?3,"End Of Line Escape (",$SELECT($PIECE(ALLVDLMS,"^",4)="":"<NULL>",1:"'"_$PIECE(ALLVDLMS,"^",4)_"'"),")"
- End DoDot:2
- +46 SET (STOP,CNT)=3
- SET SEG="999"
- FOR
- SET SEG=$ORDER(CUSASAP(SEG))
- if SEG=""
- QUIT
- Begin DoDot:2
- +47 IF $$CUSSEG^PSOSPMU3(PSOASVER,SEG)
- WRITE !?3,$PIECE(CUSASAP(SEG),"^",1),?12,$PIECE(CUSASAP(SEG),"^",2)
- SET CNT=CNT+1
- +48 SET ELM=0
- FOR
- SET ELM=$ORDER(CUSASAP(SEG,ELM))
- if 'ELM
- QUIT
- Begin DoDot:3
- +49 WRITE !?3,$PIECE(CUSASAP(SEG,ELM),"^",1),?12,$PIECE(CUSASAP(SEG,ELM),"^",2)
- SET CNT=CNT+1
- +50 IF (CNT>22)
- SET STOP=$$ASKFLD^PSOSPMA3("E",,"Enter <RET> to continue or '^' to STOP")
- SET CNT=0
- End DoDot:3
- IF STOP="^"
- QUIT
- End DoDot:2
- IF STOP="^"
- QUIT
- +51 WRITE !
- SET X=$$ASKFLD^PSOSPMA3("Y","NO","Confirm Deletion")
- IF X'=1
- QUIT
- +52 WRITE ?40,"Deleting..."
- DO DELCUS^PSOSPMU3(PSOASVER)
- HANG 1
- WRITE "OK",$CHAR(7)
- End DoDot:1
- GOTO BACK^PSOSPMA3
- +53 ;
- +54 ; Delete ASAP Segment
- +55 IF CUSTYPE="S"
- Begin DoDot:1
- +56 ; Standard ASAP Definition
- DO LOADASAP^PSOSPMU0(PSOASVER,"S",.STDASAP)
- +57 ; Custom ASAP Definition
- DO LOADASAP^PSOSPMU0(PSOASVER,"C",.CUSASAP)
- +58 WRITE !!,"ASAP Version ",PSOASVER
- +59 KILL DIR
- SET DIR("?",1)="Enter the Custom ASAP Segment ID that you want to delete."
- +60 SET DIR("?",2)=" "
- SET DIR("?",3)=" Choose from:"
- +61 SET (STOP,CNT)=0
- SET SEG="999"
- SET CNT=4
- FOR
- SET SEG=$ORDER(CUSASAP(SEG))
- if SEG=""
- QUIT
- Begin DoDot:2
- +62 SET DIR("?",CNT)=" "_SEG_" "_$PIECE(CUSASAP(SEG),"^",2)
- SET CNT=CNT+1
- End DoDot:2
- +63 SET DIR("?")=" "
- SET DIR(0)="FO^1:5"
- SET DIR("A")="SEGMENT ID"
- +64 SET SEGID=""
- SET DONE=0
- FOR
- WRITE !
- DO ^DIR
- if ($DATA(DIRUT)!$DATA(DTOUT))!(X="")
- QUIT
- Begin DoDot:2
- +65 if '$DATA(CUSASAP(X))
- SET X=$$UP^XLFSTR(X)
- IF '$DATA(CUSASAP(X))
- WRITE !,"Custom Segment not found!",$CHAR(7)
- QUIT
- +66 KILL CHILDREN
- IF '$DATA(STDASAP(X))
- Begin DoDot:3
- +67 SET SEG="999"
- FOR
- SET SEG=$ORDER(CUSASAP(SEG))
- if SEG=""
- QUIT
- IF $PIECE(CUSASAP(SEG),"^",3)=X
- SET CHILDREN(SEG)=""
- +68 IF $ORDER(CHILDREN(""))'=""
- Begin DoDot:4
- +69 WRITE !!,"The following custom children ASAP Segments must be deleted first:",!,$CHAR(7)
- +70 SET SEG=""
- FOR
- SET SEG=$ORDER(CHILDREN(SEG))
- if SEG=""
- QUIT
- WRITE !?3,SEG,?12,$PIECE(CUSASAP(SEG),"^",2)
- End DoDot:4
- End DoDot:3
- IF $ORDER(CHILDREN(""))'=""
- QUIT
- +71 SET SEGID=X
- WRITE " ",$PIECE(CUSASAP(SEGID),"^",2)
- SET DONE=1
- End DoDot:2
- IF DONE
- QUIT
- +72 IF 'DONE
- QUIT
- +73 IF $DATA(STDASAP(SEGID))
- Begin DoDot:2
- +74 WRITE !!,"The customization for the Segment '",SEGID,"' and all of its custom Data Elements"
- +75 WRITE !,"will be deleted and the standard definition will be restored.",!
- End DoDot:2
- +76 IF '$TEST
- Begin DoDot:2
- +77 WRITE !!,"The custom Segment '",SEGID,"' and all of its Data Elements will be deleted.",!
- End DoDot:2
- +78 SET STOP=""
- SET (ELM,CNT)=0
- FOR
- SET ELM=$ORDER(CUSASAP(SEGID,ELM))
- if ELM=""
- QUIT
- Begin DoDot:2
- +79 WRITE !?3,$PIECE(CUSASAP(SEGID,ELM),"^",1),?12,$PIECE(CUSASAP(SEGID,ELM),"^",2)
- SET CNT=CNT+1
- +80 IF (CNT>18)
- SET STOP=$$ASKFLD^PSOSPMA3("E",,"Enter <RET> to continue or '^' to STOP")
- SET CNT=0
- End DoDot:2
- +81 WRITE !
- SET X=$$ASKFLD^PSOSPMA3("Y","NO","Confirm Deletion")
- IF X'=1
- QUIT
- +82 WRITE ?40,"Deleting..."
- DO DELCUS^PSOSPMU3(PSOASVER,SEGID)
- HANG 1
- WRITE "OK",$CHAR(7)
- End DoDot:1
- GOTO BACK^PSOSPMA3
- +83 ;
- +84 ; Delete ASAP Data Element
- +85 IF CUSTYPE="E"
- Begin DoDot:1
- +86 ; Standard ASAP Definition
- DO LOADASAP^PSOSPMU0(PSOASVER,"S",.STDASAP)
- +87 ; Custom ASAP Definition
- DO LOADASAP^PSOSPMU0(PSOASVER,"C",.CUSASAP)
- +88 WRITE !!,"ASAP Version ",PSOASVER
- +89 KILL DIR
- SET DIR("?",1)="Enter the Custom ASAP Data Element that you want to delete."
- +90 SET DIR("?",2)=" "
- SET DIR("?",3)=" Choose from:"
- +91 SET SEG="999"
- SET CNT=4
- FOR
- SET SEG=$ORDER(CUSASAP(SEG))
- if SEG=""
- QUIT
- Begin DoDot:2
- +92 SET ELM=0
- FOR
- SET ELM=$ORDER(CUSASAP(SEG,ELM))
- if 'ELM
- QUIT
- Begin DoDot:3
- +93 SET DIR("?",CNT)=" "_$PIECE(CUSASAP(SEG,ELM),"^")_" "_$PIECE(CUSASAP(SEG,ELM),"^",2)
- SET CNT=CNT+1
- End DoDot:3
- End DoDot:2
- +94 SET DIR("?")=" "
- SET DIR(0)="FO^1:10"
- SET DIR("A")="DATA ELEMENT ID"
- +95 SET DONE=0
- FOR
- WRITE !
- DO ^DIR
- if ($DATA(DIRUT)!$DATA(DTOUT))!(X="")
- QUIT
- Begin DoDot:2
- +96 IF '$DATA(CUSASAP($$GETSEGID^PSOSPMU3(X)))
- SET X=$$UP^XLFSTR(X)
- +97 SET SEGID=$$GETSEGID^PSOSPMU3(X)
- SET ELMPOS=+$PIECE(X,SEGID,2)
- +98 IF '$DATA(CUSASAP(SEGID,ELMPOS))
- WRITE !,"Custom Data Element not found!",$CHAR(7)
- QUIT
- +99 IF $DATA(CUSASAP(SEGID,ELMPOS+1))
- IF '$DATA(STDASAP(SEGID,ELMPOS+1))
- Begin DoDot:3
- +100 WRITE !,"Only the last Custom Data Element in the Segment can be deleted.",$CHAR(7)
- End DoDot:3
- QUIT
- +101 WRITE " ",$PIECE(CUSASAP(SEGID),"^",2)
- SET DONE=1
- End DoDot:2
- IF DONE
- QUIT
- +102 IF 'DONE
- QUIT
- +103 IF $DATA(STDASAP(SEGID,ELMPOS))
- Begin DoDot:2
- +104 WRITE !!,"The customization for the Data Element '",$PIECE(STDASAP(SEGID,ELMPOS),"^"),"' will be deleted and the"
- +105 WRITE !,"standard definition will be restored.",!
- End DoDot:2
- +106 IF '$TEST
- Begin DoDot:2
- +107 WRITE !!,"The custom Data Element '",$PIECE(CUSASAP(SEGID,ELMPOS),"^",1),"' will be deleted.",!
- End DoDot:2
- +108 SET X=$$ASKFLD^PSOSPMA3("Y","NO","Confirm Deletion")
- IF X'=1
- QUIT
- +109 WRITE ?40,"Deleting..."
- DO DELCUS^PSOSPMU3(PSOASVER,SEGID,$PIECE(CUSASAP(SEGID,ELMPOS),"^",1))
- HANG 1
- WRITE "OK",$CHAR(7)
- End DoDot:1
- GOTO BACK^PSOSPMA3
- +110 GOTO BACK^PSOSPMA3
- +111 ;
- VERINUSE(PSOASVER) ; Verify whether the ASAP Version is in use or not
- +1 ; Input: (r) PSOASVER - Source ASAP Version to be cloned (3.0, 4.0, 4.1, 4.2)
- +2 ;Output: $$VERINUSE - Pointer to first the STATE file (#5) that is using the ASAP Version
- +3 NEW STATE,VERINUSE
- +4 SET (STATE,VERINUSE)=0
- FOR
- SET STATE=$ORDER(^PS(58.41,STATE))
- if 'STATE
- QUIT
- Begin DoDot:1
- +5 IF $$GET1^DIQ(58.41,STATE,1,"I")=PSOASVER
- SET VERINUSE=STATE
- End DoDot:1
- IF VERINUSE
- QUIT
- +6 QUIT VERINUSE
