DVBALD1 ;ALB/JLU;extension of DVBALD;9/19/94
;;2.7;AMIE;;Apr 10, 1995
;
ADD(WHO) ;this is used by both the add and create actions of List Man
;discharge.
K DVBAQUIT
S VAR(1,0)="0,0,0,2,1^"_$S(WHO="AD":"You may now add to the default list of discharge types.",1:"You may now select a new list of discharge types.")
S VAR(2,0)="0,0,0,1,0^Both 'active' and 'inactive' discharge types can be selected."
S VAR(3,0)="0,0,0,1:2,0^If help or a list is needed enter a '?'"
D WR^DVBAUTL4("VAR")
K VAR
S DVBIEDSC=$$DSCTIEN^DVBAUTL6("DISCHARGE") ;gets the IFN of "discharge"
I DVBIEDSC<1 DO Q
.S VAR(1,0)="1,0,0,2,0^No discharge type MAS Movement Transaction type was found"
.S VAR(2,0)="0,0,0,1,0^Contact your site manager."
.D WR^DVBAUTL4("VAR")
.S DVBAQUIT=1
.K VAR
.Q
F DO Q:$D(DVBAQUIT) ;loop to keep asking for movement types
.S DIC="^DG(405.2,",DIC(0)="AEMQZ"
.S DIC("S")="I DVBIEDSC=$P(^(0),U,2)!(+Y=18)!(+Y=40)!(+Y=43) I '$D(^TMP(""DVBA"",$J,""DUP"",+Y))"
.D ^DIC
.I +Y>0 DO
..I $$CHECKDUP(+Y) Q ;checks for duplicates not really needed but
..D SETARAY(Y)
..Q
.I +Y<1 S DVBAQUIT=1
.Q
K DVBIEDSC
Q
;
CHECKDUP(A) ;checks if an entry has already been selected. if yes returns a 1
I $D(^TMP("DVBA",$J,"DUP",+Y)) DO Q 1
.S VAR(1,0)="1,0,0,2,0^This discharge type has already been selected."
.D WR^DVBAUTL4("VAR")
.K VAR
.Q
E Q 0
;
SETARAY(A) ;sets the necessary listmanager and global arrays for this
;selection
;A is the IEN of the discharge type and the second piece is the
;external value
N TEXT
S VALMCNT=VALMCNT+1
S TEXT=$$SETFLD^VALM1(VALMCNT,"","ITEM")
S TEXT=$$SETFLD^VALM1($P(A,U,2),TEXT,"DISCHARGE TYPE")
S TEXT=$$SETFLD^VALM1(+A,TEXT,"DISCHARGE CODE")
S DVBA=$$CHECK^DVBAUTL6(+A)
I DVBA=0 S TEXT=$$SETFLD^VALM1("INACTIVE",TEXT,"STATUS")
S @VALMAR@(VALMCNT,0)=TEXT
S @VALMAR@("IDX",VALMCNT,VALMCNT)=""
S ^TMP("DVBA",$J,"DUP",+A)=""
S @VALMAR@("FND",VALMCNT,+A)=""
Q
;
DELETE ;This entry point allows the users to delete from the list of discharge
;types
K DVBAQUIT
F DO Q:$D(DVBAQUIT)
.D RE^VALM4
.S VALMNOD=$G(XQORNOD(0))
.D EN^VALM2(VALMNOD,"O")
.I '$O(VALMY("")) S DVBAQUIT=1 Q
.S DVBA=""
.F S DVBA=$O(VALMY(DVBA)) Q:DVBA="" DO
..S DVBB=$O(@VALMAR@("FND",DVBA,0))
..K ^TMP("DVBA",$J,"DUP",DVBB)
..K @VALMAR@("FND",DVBA,DVBB)
..K @VALMAR@(DVBA,0)
..K @VALMAR@("IDX",DVBA)
..Q
.D RELIST
.Q
K DVBA,DVBB
Q
;
RELIST ;re-organizes the list after a deletion
N DVBA,DVBOLD,DVBOLDC
S VALMCNT=0,DVBA=""
F S DVBA=$O(@VALMAR@(DVBA)) Q:'DVBA DO
.S VALMCNT=VALMCNT+1
.S DVBOLD=$$SETFLD^VALM1(VALMCNT,@VALMAR@(DVBA,0),"ITEM")
.S DVBOLDC=$O(@VALMAR@("FND",DVBA,0))
.K @VALMAR@(DVBA,0)
.K @VALMAR@("IDX",DVBA)
.K @VALMAR@("FND",DVBA)
.S @VALMAR@(VALMCNT,0)=DVBOLD
.S @VALMAR@("IDX",VALMCNT,VALMCNT)=""
.S @VALMAR@("FND",VALMCNT,DVBOLDC)=""
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBALD1 2927 printed Apr 09, 2024@20:48:10 Page 2
DVBALD1 ;ALB/JLU;extension of DVBALD;9/19/94
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
ADD(WHO) ;this is used by both the add and create actions of List Man
+1 ;discharge.
+2 KILL DVBAQUIT
+3 SET VAR(1,0)="0,0,0,2,1^"_$SELECT(WHO="AD":"You may now add to the default list of discharge types.",1:"You may now select a new list of discharge types.")
+4 SET VAR(2,0)="0,0,0,1,0^Both 'active' and 'inactive' discharge types can be selected."
+5 SET VAR(3,0)="0,0,0,1:2,0^If help or a list is needed enter a '?'"
+6 DO WR^DVBAUTL4("VAR")
+7 KILL VAR
+8 ;gets the IFN of "discharge"
SET DVBIEDSC=$$DSCTIEN^DVBAUTL6("DISCHARGE")
+9 IF DVBIEDSC<1
Begin DoDot:1
+10 SET VAR(1,0)="1,0,0,2,0^No discharge type MAS Movement Transaction type was found"
+11 SET VAR(2,0)="0,0,0,1,0^Contact your site manager."
+12 DO WR^DVBAUTL4("VAR")
+13 SET DVBAQUIT=1
+14 KILL VAR
+15 QUIT
End DoDot:1
QUIT
+16 ;loop to keep asking for movement types
FOR
Begin DoDot:1
+17 SET DIC="^DG(405.2,"
SET DIC(0)="AEMQZ"
+18 SET DIC("S")="I DVBIEDSC=$P(^(0),U,2)!(+Y=18)!(+Y=40)!(+Y=43) I '$D(^TMP(""DVBA"",$J,""DUP"",+Y))"
+19 DO ^DIC
+20 IF +Y>0
Begin DoDot:2
+21 ;checks for duplicates not really needed but
IF $$CHECKDUP(+Y)
QUIT
+22 DO SETARAY(Y)
+23 QUIT
End DoDot:2
+24 IF +Y<1
SET DVBAQUIT=1
+25 QUIT
End DoDot:1
if $DATA(DVBAQUIT)
QUIT
+26 KILL DVBIEDSC
+27 QUIT
+28 ;
CHECKDUP(A) ;checks if an entry has already been selected. if yes returns a 1
+1 IF $DATA(^TMP("DVBA",$JOB,"DUP",+Y))
Begin DoDot:1
+2 SET VAR(1,0)="1,0,0,2,0^This discharge type has already been selected."
+3 DO WR^DVBAUTL4("VAR")
+4 KILL VAR
+5 QUIT
End DoDot:1
QUIT 1
+6 IF '$TEST
QUIT 0
+7 ;
SETARAY(A) ;sets the necessary listmanager and global arrays for this
+1 ;selection
+2 ;A is the IEN of the discharge type and the second piece is the
+3 ;external value
+4 NEW TEXT
+5 SET VALMCNT=VALMCNT+1
+6 SET TEXT=$$SETFLD^VALM1(VALMCNT,"","ITEM")
+7 SET TEXT=$$SETFLD^VALM1($PIECE(A,U,2),TEXT,"DISCHARGE TYPE")
+8 SET TEXT=$$SETFLD^VALM1(+A,TEXT,"DISCHARGE CODE")
+9 SET DVBA=$$CHECK^DVBAUTL6(+A)
+10 IF DVBA=0
SET TEXT=$$SETFLD^VALM1("INACTIVE",TEXT,"STATUS")
+11 SET @VALMAR@(VALMCNT,0)=TEXT
+12 SET @VALMAR@("IDX",VALMCNT,VALMCNT)=""
+13 SET ^TMP("DVBA",$JOB,"DUP",+A)=""
+14 SET @VALMAR@("FND",VALMCNT,+A)=""
+15 QUIT
+16 ;
DELETE ;This entry point allows the users to delete from the list of discharge
+1 ;types
+2 KILL DVBAQUIT
+3 FOR
Begin DoDot:1
+4 DO RE^VALM4
+5 SET VALMNOD=$GET(XQORNOD(0))
+6 DO EN^VALM2(VALMNOD,"O")
+7 IF '$ORDER(VALMY(""))
SET DVBAQUIT=1
QUIT
+8 SET DVBA=""
+9 FOR
SET DVBA=$ORDER(VALMY(DVBA))
if DVBA=""
QUIT
Begin DoDot:2
+10 SET DVBB=$ORDER(@VALMAR@("FND",DVBA,0))
+11 KILL ^TMP("DVBA",$JOB,"DUP",DVBB)
+12 KILL @VALMAR@("FND",DVBA,DVBB)
+13 KILL @VALMAR@(DVBA,0)
+14 KILL @VALMAR@("IDX",DVBA)
+15 QUIT
End DoDot:2
+16 DO RELIST
+17 QUIT
End DoDot:1
if $DATA(DVBAQUIT)
QUIT
+18 KILL DVBA,DVBB
+19 QUIT
+20 ;
RELIST ;re-organizes the list after a deletion
+1 NEW DVBA,DVBOLD,DVBOLDC
+2 SET VALMCNT=0
SET DVBA=""
+3 FOR
SET DVBA=$ORDER(@VALMAR@(DVBA))
if 'DVBA
QUIT
Begin DoDot:1
+4 SET VALMCNT=VALMCNT+1
+5 SET DVBOLD=$$SETFLD^VALM1(VALMCNT,@VALMAR@(DVBA,0),"ITEM")
+6 SET DVBOLDC=$ORDER(@VALMAR@("FND",DVBA,0))
+7 KILL @VALMAR@(DVBA,0)
+8 KILL @VALMAR@("IDX",DVBA)
+9 KILL @VALMAR@("FND",DVBA)
+10 SET @VALMAR@(VALMCNT,0)=DVBOLD
+11 SET @VALMAR@("IDX",VALMCNT,VALMCNT)=""
+12 SET @VALMAR@("FND",VALMCNT,DVBOLDC)=""
+13 QUIT
End DoDot:1
+14 QUIT
