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 Dec 13, 2024@02:34:59 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
