WIILM ;VISN20/WDE/WHN - WII List Manager Routine ; 21-JUN-2008
 ;;1.0;Wounded Injured and Ill Warriors;**1**;06/26/2008;Build 28
 ; ListManager functionality designed through the List Manager Work Bench "^VALMWB" 
 ; ------------Variable list------------------
 ;  WIIAD    --  movement admission date
 ;  WIIDD    --  movement discharge date
 ;  WIILN    --  listmanager line number
 ;  WIILVAR  --  listmanager line/column information
 ;  WIINA    --  patient name
 ;  WIINODE  --  zer0th node of the WII file entry
 ;  WIISSN   --  patient SSN
 ;  WIIVA    --  facility number
 ;  WIIX     --  IEN of file entry
EN ; -- main entry point for WII LM
 D EN^VALM("WII LM")
 Q
HDR ; -- header code
 K X S $P(X," ",(80-$L("Active Duty Service Member - Admission/Discharges")\2))=""
 S VALMHDR(1)=X_"Active Duty Service Member - Admission/Discharges"
 K X S $P(X," ",(80-$L("Pending Action List")\2))=""
 S VALMHDR(2)=X_"Pending Action List"
 Q
INIT ; -- init variables and list array
 S (WIILN,WIIX)=0 F  S WIIX=$O(^WII(987.5,"C",1,WIIX)) Q:WIIX=""  D
 . S WIILN=WIILN+1
 . S WIINODE=$G(^WII(987.5,WIIX,0)),WIILVAR=""
 . S WIINA=$P(WIINODE,U,2),WIISSN=$P(WIINODE,U,3),WIIAD=$P(WIINODE,U,6),WIIDD=$P(WIINODE,U,7),WIIVA=$P(WIINODE,U,5)
 . S WIILVAR=$$SETFLD^VALM1(WIILN_".",WIILVAR,"LINENO")
 . S WIILVAR=$$SETFLD^VALM1(WIINA,WIILVAR,"NAME")
 . S WIILVAR=$$SETFLD^VALM1(WIISSN,WIILVAR,"SSN")
 . S WIILVAR=$$SETFLD^VALM1(WIIAD,WIILVAR,"ADT")
 . S WIILVAR=$$SETFLD^VALM1(WIIDD,WIILVAR,"DDT")
 . S WIILVAR=$$SETFLD^VALM1(WIIVA,WIILVAR,"VA")
 . S WIILVAR=$$SETFLD^VALM1(WIIX,WIILVAR,"WII")
 . D SET^VALM10(WIILN,WIILVAR,WIIX)
 S VALMCNT=WIILN
 ;I WIILN<1 S @VALMAR@(1,0)=" No Active Duty Admissions/Discharges to Review"
 K WIIAD,WIIDD,WIILN,WIILVAR,WIINA,WIINODE,WIISSN,WIIVA,WIIX
 Q
HELP ; -- help code
 S X="?" D DISP^XQORM1 W !!
 Q
EXIT ; -- exit code
 I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
 Q
EXPND ; -- expand code
 D EX^WIILM02
 Q
ZAP ;
 K VALMBCK,VALMCNT,VALMHDR
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWIILM   2059     printed  Sep 23, 2025@20:22:44                                                                                                                                                                                                       Page 2
WIILM     ;VISN20/WDE/WHN - WII List Manager Routine ; 21-JUN-2008
 +1       ;;1.0;Wounded Injured and Ill Warriors;**1**;06/26/2008;Build 28
 +2       ; ListManager functionality designed through the List Manager Work Bench "^VALMWB" 
 +3       ; ------------Variable list------------------
 +4       ;  WIIAD    --  movement admission date
 +5       ;  WIIDD    --  movement discharge date
 +6       ;  WIILN    --  listmanager line number
 +7       ;  WIILVAR  --  listmanager line/column information
 +8       ;  WIINA    --  patient name
 +9       ;  WIINODE  --  zer0th node of the WII file entry
 +10      ;  WIISSN   --  patient SSN
 +11      ;  WIIVA    --  facility number
 +12      ;  WIIX     --  IEN of file entry
EN        ; -- main entry point for WII LM
 +1        DO EN^VALM("WII LM")
 +2        QUIT 
HDR       ; -- header code
 +1        KILL X
           SET $PIECE(X," ",(80-$LENGTH("Active Duty Service Member - Admission/Discharges")\2))=""
 +2        SET VALMHDR(1)=X_"Active Duty Service Member - Admission/Discharges"
 +3        KILL X
           SET $PIECE(X," ",(80-$LENGTH("Pending Action List")\2))=""
 +4        SET VALMHDR(2)=X_"Pending Action List"
 +5        QUIT 
INIT      ; -- init variables and list array
 +1        SET (WIILN,WIIX)=0
           FOR 
               SET WIIX=$ORDER(^WII(987.5,"C",1,WIIX))
               if WIIX=""
                   QUIT 
               Begin DoDot:1
 +2                SET WIILN=WIILN+1
 +3                SET WIINODE=$GET(^WII(987.5,WIIX,0))
                   SET WIILVAR=""
 +4                SET WIINA=$PIECE(WIINODE,U,2)
                   SET WIISSN=$PIECE(WIINODE,U,3)
                   SET WIIAD=$PIECE(WIINODE,U,6)
                   SET WIIDD=$PIECE(WIINODE,U,7)
                   SET WIIVA=$PIECE(WIINODE,U,5)
 +5                SET WIILVAR=$$SETFLD^VALM1(WIILN_".",WIILVAR,"LINENO")
 +6                SET WIILVAR=$$SETFLD^VALM1(WIINA,WIILVAR,"NAME")
 +7                SET WIILVAR=$$SETFLD^VALM1(WIISSN,WIILVAR,"SSN")
 +8                SET WIILVAR=$$SETFLD^VALM1(WIIAD,WIILVAR,"ADT")
 +9                SET WIILVAR=$$SETFLD^VALM1(WIIDD,WIILVAR,"DDT")
 +10               SET WIILVAR=$$SETFLD^VALM1(WIIVA,WIILVAR,"VA")
 +11               SET WIILVAR=$$SETFLD^VALM1(WIIX,WIILVAR,"WII")
 +12               DO SET^VALM10(WIILN,WIILVAR,WIIX)
               End DoDot:1
 +13       SET VALMCNT=WIILN
 +14      ;I WIILN<1 S @VALMAR@(1,0)=" No Active Duty Admissions/Discharges to Review"
 +15       KILL WIIAD,WIIDD,WIILN,WIILVAR,WIINA,WIINODE,WIISSN,WIIVA,WIIX
 +16       QUIT 
HELP      ; -- help code
 +1        SET X="?"
           DO DISP^XQORM1
           WRITE !!
 +2        QUIT 
EXIT      ; -- exit code
 +1        IF $DATA(VALMBCK)
               IF VALMBCK="R"
                   DO REFRESH^VALM
                   SET VALMBCK=$PIECE(VALMBCK,"R")_$PIECE(VALMBCK,"R",2)
 +2        QUIT 
EXPND     ; -- expand code
 +1        DO EX^WIILM02
 +2        QUIT 
ZAP       ;
 +1        KILL VALMBCK,VALMCNT,VALMHDR