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