WIILM.m

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 ---WIILM   2059     printed  Apr 09, 2024@21:48:41                                                                                                                                                                                                       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