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 Oct 16, 2024@18:46:55 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
