WIILM03 ;VISN20/WDE/WHN - WII LM SCREEN FOR PENDING TRANSMISSION ; 26-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 STATUS 2 REVIEW
D EN^VALM("WII LM STS 2 REVIEW")
Q
;
HDR ; -- header code
K X S $P(X," ",(80-$L("Admission/Discharges Flagged Approved for forwarding to DFAS")\2))=""
S VALMHDR(1)=X_"Admission/Discharges Flagged Approved for forwarding to DFAS"
S VALMHDR(2)=""
Q
INIT ; -- init variables and list array
S (WIILN,WIIX)=0 F S WIIX=$O(^WII(987.5,"C",2,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 Admission/Discharge have been approved"
K WIIAD,WIIDD,WIILN,WIILVAR,WIINA,WIINODE,WIISSN,WIIVA,WIIX
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
EXIT ; -- exit code
D CLEAN^VALM10 I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
Q
EXPND ; -- expand code
Q
LJ(X,L) ; left justify function X=string L=length
S X=X_" ",X=$E(X,1,L) Q X
Q
ZAP ;
K DIE,DIRUT,DA,Y,X,DR,STATUS,WIILN,VALMAR,VALMBG,VALMCNT,VALMLST,WIIEN,WIILN,WIINODE,WIIX,WIIY,WIIZ,Y,VALMBCK,VALMHDR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWIILM03 2258 printed Oct 16, 2024@18:46:58 Page 2
WIILM03 ;VISN20/WDE/WHN - WII LM SCREEN FOR PENDING TRANSMISSION ; 26-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 STATUS 2 REVIEW
+1 DO EN^VALM("WII LM STS 2 REVIEW")
+2 QUIT
+3 ;
HDR ; -- header code
+1 KILL X
SET $PIECE(X," ",(80-$LENGTH("Admission/Discharges Flagged Approved for forwarding to DFAS")\2))=""
+2 SET VALMHDR(1)=X_"Admission/Discharges Flagged Approved for forwarding to DFAS"
+3 SET VALMHDR(2)=""
+4 QUIT
INIT ; -- init variables and list array
+1 SET (WIILN,WIIX)=0
FOR
SET WIIX=$ORDER(^WII(987.5,"C",2,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 IF WIILN<1
SET @VALMAR@(1,0)=" No Active Duty Admission/Discharge have been approved"
+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 DO CLEAN^VALM10
IF $DATA(VALMBCK)
IF VALMBCK="R"
DO REFRESH^VALM
SET VALMBCK=$PIECE(VALMBCK,"R")_$PIECE(VALMBCK,"R",2)
+2 QUIT
EXPND ; -- expand code
+1 QUIT
LJ(X,L) ; left justify function X=string L=length
+1 SET X=X_" "
SET X=$EXTRACT(X,1,L)
QUIT X
+2 QUIT
ZAP ;
+1 KILL DIE,DIRUT,DA,Y,X,DR,STATUS,WIILN,VALMAR,VALMBG,VALMCNT,VALMLST,WIIEN,WIILN,WIINODE,WIIX,WIIY,WIIZ,Y,VALMBCK,VALMHDR
