Routine: WIILM01

WIILM01 ;VISN20/WDE/WHN -  WII List Manager Actions ; 21-JUN-2008

 ;;1.0;Wounded Injured and Ill Warriors;**1**;06/26/2008;Build 28

TR ; mark entry as approved for submission to DFAS

 Q:VALMCNT<1     ; quit if there aren't any entries on the current list

 K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST,DIR("A")="Select records to Transmit" D ^DIR  K DIR Q:$D(DIRUT)

 S WIIY=Y                ; save the DIR processed response

 ; check if multiple records were selected by counting the number of "," pieces using WIIX

 ; if WIIX has more than one comma delimited value ForLoop through the WIIY setting WIIZ to

 ; the next number in list. WIILN set to reference LM line number and WIIEN to the file 987.5

 ; IEN set in LM array "IDX" x-ref.

 ; FM API called to update the status field to "2:Transmission Approved"

 S WIIX=$L(WIIY,",")-1

 I WIIX=1 S WIIEN=$O(@VALMAR@("IDX",+WIIY,"")) D FILE(WIIEN,2)

 I WIIX>1 F WIIZ=1:1:WIIX S WIILN=$P(WIIY,",",WIIZ),WIIEN=$O(@VALMAR@("IDX",+WIILN,"")) D FILE(WIIEN,2)

 W !,"Record"_$S(WIIX>1:"s ",1:" "),WIIY," will be put in the transmit queue"

 ; clean up the LM display variables and reload the list

 D CLEAN^VALM10,INIT^WIILM Q

PL ; print delimited list of all records in current list for export spread sheet

 ; using WIIY to $Order through LM "IDX" list x-ref set WIIEN to the file IEN and WIINODE to

 ; the zer0th node of the entry. Build delimited "^" file with DFAS info to export.

 D FULL^VALM1

 W @IOF

 W !!,"NAME",U,"SSN",U,"ADMISSION DATE",U,"DISCHARGE DATE",U,"FACILITY #"

 S (WIIY,WIIEN)="" F  S WIIY=$O(@VALMAR@("IDX",WIIY)) Q:WIIY=""  F  S WIIEN=$O(@VALMAR@("IDX",WIIY,WIIEN)) Q:WIIEN=""  D

 . S WIINODE=$G(^WII(987.5,WIIEN,0))

 . W !,$P(WIINODE,U,2),U,$P(WIINODE,U,3),U,$P(WIINODE,U,6),U,$P(WIINODE,U,7),U,$P(WIINODE,U,5)

 D PAUSE^VALM1

RM ; set status field to not approved and remove from displayed list

 Q:VALMCNT<1     ; quit if there aren't any entries on the current list

 K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST,DIR("A")="Select records to remove" D ^DIR  K DIR Q:$D(DIRUT)

 S WIIY=Y                ; save the DIR processed response

 ; check if multiple records were selected by counting the number of "," pieces using WIIX

 ; if WIIX has more than one comma delimited value ForLoop through the WIIY setting WIIZ to

 ; the next number in list. WIILN set to reference LM line number and WIIEN to the file 987.5

 ; IEN set in LM array "IDX" x-ref.

 ; FM API called to update the status field to "3:Transmission Not Approved"

 S WIIX=$L(WIIY,",")-1

 I WIIX=1 S WIIEN=$O(@VALMAR@("IDX",+WIIY,"")) D FILE(WIIEN,3)

 I WIIX>1 F WIIZ=1:1:WIIX S WIILN=$P(WIIY,",",WIIZ),WIIEN=$O(@VALMAR@("IDX",+WIILN,"")) D FILE(WIIEN,3)

 W !,"Record"_$S(WIIX>1:"s ",1:" "),WIIY," will be removed from the list"

 ; clean up the LM display variables and reload the list

 D CLEAN^VALM10,INIT^WIILM Q

PD ; reset status to pending from approved

 Q:VALMCNT<1     ; quit if there aren't any entries on the current list

 K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST,DIR("A")="Select records to remove" D ^DIR  K DIR Q:$D(DIRUT)

 S WIIY=Y                ; save the DIR processed response

 ; check if multiple records were selected by counting the number of "," pieces using WIIX

 ; if WIIX has more than one comma delimited value ForLoop through the WIIY setting WIIZ to

 ; the next number in list. WIILN set to reference LM line number and WIIEN to the file 987.5

 ; IEN set in LM array "IDX" x-ref.

 ; FM API called to update the status field to "1:Pending facility approval"

 S WIIX=$L(WIIY,",")-1

 I WIIX=1 S WIIEN=$O(@VALMAR@("IDX",+WIIY,"")) D FILE(WIIEN,1)

 I WIIX>1 F WIIZ=1:1:WIIX S WIILN=$P(WIIY,",",WIIZ),WIIEN=$O(@VALMAR@("IDX",+WIILN,"")) D FILE(WIIEN,1)

 W !,"Record"_$S(WIIX>1:"s ",1:" "),WIIY," will be marked pending"

 ; clean up the LM display variables and reload the list

 D CLEAN^VALM10,INIT^WIILM03 Q

PD3 ; reset status to pending from deleted

 Q:VALMCNT<1     ; quit if there aren't any entries on the current list

 K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST,DIR("A")="Select records to remove" D ^DIR  K DIR Q:$D(DIRUT)

 S WIIY=Y                ; save the DIR processed response

 ; check if multiple records were selected by counting the number of "," pieces using WIIX

 ; if WIIX has more than one comma delimited value ForLoop through the WIIY setting WIIZ to

 ; the next number in list. WIILN set to reference LM line number and WIIEN to the file 987.5

 ; IEN set in LM array "IDX" x-ref.

 ; FM API called to update the status field to "1:Pending facility approval"

 S WIIX=$L(WIIY,",")-1

 I WIIX=1 S WIIEN=$O(@VALMAR@("IDX",+WIIY,"")) D FILE(WIIEN,1)

 I WIIX>1 F WIIZ=1:1:WIIX S WIILN=$P(WIIY,",",WIIZ),WIIEN=$O(@VALMAR@("IDX",+WIILN,"")) D FILE(WIIEN,1)

 W !,"Records ",WIIY," will be marked pending"

 ; clean up the LM display variables and reload the list

 D CLEAN^VALM10,INIT^WIILM04 Q

FILE(DA,STATUS) ; file status change

 Q:'+DA

 S DIE="^WII(987.5,",DR="8///"_+STATUS_";10///"_$G(DUZ)_";11///"_DT L +^WII(987.5,DA):0 I $T D ^DIE L -^WII(987.5,DA)

ZAP ;

 K DIE,DIRUT,DA,Y,X,DR,STATUS,WIILN,VALMAR,VALMBG,VALMCNT,VALMLST,WIIEN,WIILN,WIINODE,WIIX,WIIY,WIIZ,Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWIILM01   5218     printed  Mar 13, 2025@21:51:33                                                                                                                                                                                                     Page 2

WIILM01   ;VISN20/WDE/WHN -  WII List Manager Actions ; 21-JUN-2008

 +1       ;;1.0;Wounded Injured and Ill Warriors;**1**;06/26/2008;Build 28

 +2       ;

TR        ; mark entry as approved for submission to DFAS

 +1       ; quit if there aren't any entries on the current list

           if VALMCNT<1

               QUIT

 +2        KILL DIR

           SET DIR(0)="LO^"_VALMBG_":"_VALMLST

           SET DIR("A")="Select records to Transmit"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               QUIT

 +3       ; save the DIR processed response

           SET WIIY=Y

 +4       ; check if multiple records were selected by counting the number of "," pieces using WIIX

 +5       ; if WIIX has more than one comma delimited value ForLoop through the WIIY setting WIIZ to

 +6       ; the next number in list. WIILN set to reference LM line number and WIIEN to the file 987.5

 +7       ; IEN set in LM array "IDX" x-ref.

 +8       ; FM API called to update the status field to "2:Transmission Approved"

 +9        SET WIIX=$LENGTH(WIIY,",")-1

 +10       IF WIIX=1

               SET WIIEN=$ORDER(@VALMAR@("IDX",+WIIY,""))

               DO FILE(WIIEN,2)

 +11       IF WIIX>1

               FOR WIIZ=1:1:WIIX

                   SET WIILN=$PIECE(WIIY,",",WIIZ)

                   SET WIIEN=$ORDER(@VALMAR@("IDX",+WIILN,""))

                   DO FILE(WIIEN,2)

 +12       WRITE !,"Record"_$SELECT(WIIX>1:"s ",1:" "),WIIY," will be put in the transmit queue"

 +13      ; clean up the LM display variables and reload the list

 +14       DO CLEAN^VALM10

           DO INIT^WIILM

           QUIT

 +15       QUIT

PL        ; print delimited list of all records in current list for export spread sheet

 +1       ; using WIIY to $Order through LM "IDX" list x-ref set WIIEN to the file IEN and WIINODE to

 +2       ; the zer0th node of the entry. Build delimited "^" file with DFAS info to export.

 +3        DO FULL^VALM1

 +4        WRITE @IOF

 +5        WRITE !!,"NAME",U,"SSN",U,"ADMISSION DATE",U,"DISCHARGE DATE",U,"FACILITY #"

 +6        SET (WIIY,WIIEN)=""

FOR

               SET WIIY=$ORDER(@VALMAR@("IDX",WIIY))

               if WIIY=""

                   QUIT

FOR

                   SET WIIEN=$ORDER(@VALMAR@("IDX",WIIY,WIIEN))

                   if WIIEN=""

                       QUIT

                   Begin DoDot:1

 +7                    SET WIINODE=$GET(^WII(987.5,WIIEN,0))

 +8                    WRITE !,$PIECE(WIINODE,U,2),U,$PIECE(WIINODE,U,3),U,$PIECE(WIINODE,U,6),U,$PIECE(WIINODE,U,7),U,$PIECE(WIINODE,U,5)

                   End DoDot:1

 +9        DO PAUSE^VALM1

 +10       QUIT

RM        ; set status field to not approved and remove from displayed list

 +1       ; quit if there aren't any entries on the current list

           if VALMCNT<1

               QUIT

 +2        KILL DIR

           SET DIR(0)="LO^"_VALMBG_":"_VALMLST

           SET DIR("A")="Select records to remove"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               QUIT

 +3       ; save the DIR processed response

           SET WIIY=Y

 +4       ; check if multiple records were selected by counting the number of "," pieces using WIIX

 +5       ; if WIIX has more than one comma delimited value ForLoop through the WIIY setting WIIZ to

 +6       ; the next number in list. WIILN set to reference LM line number and WIIEN to the file 987.5

 +7       ; IEN set in LM array "IDX" x-ref.

 +8       ; FM API called to update the status field to "3:Transmission Not Approved"

 +9        SET WIIX=$LENGTH(WIIY,",")-1

 +10       IF WIIX=1

               SET WIIEN=$ORDER(@VALMAR@("IDX",+WIIY,""))

               DO FILE(WIIEN,3)

 +11       IF WIIX>1

               FOR WIIZ=1:1:WIIX

                   SET WIILN=$PIECE(WIIY,",",WIIZ)

                   SET WIIEN=$ORDER(@VALMAR@("IDX",+WIILN,""))

                   DO FILE(WIIEN,3)

 +12       WRITE !,"Record"_$SELECT(WIIX>1:"s ",1:" "),WIIY," will be removed from the list"

 +13      ; clean up the LM display variables and reload the list

 +14       DO CLEAN^VALM10

           DO INIT^WIILM

           QUIT

 +15       QUIT

PD        ; reset status to pending from approved

 +1       ; quit if there aren't any entries on the current list

           if VALMCNT<1

               QUIT

 +2        KILL DIR

           SET DIR(0)="LO^"_VALMBG_":"_VALMLST

           SET DIR("A")="Select records to remove"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               QUIT

 +3       ; save the DIR processed response

           SET WIIY=Y

 +4       ; check if multiple records were selected by counting the number of "," pieces using WIIX

 +5       ; if WIIX has more than one comma delimited value ForLoop through the WIIY setting WIIZ to

 +6       ; the next number in list. WIILN set to reference LM line number and WIIEN to the file 987.5

 +7       ; IEN set in LM array "IDX" x-ref.

 +8       ; FM API called to update the status field to "1:Pending facility approval"

 +9        SET WIIX=$LENGTH(WIIY,",")-1

 +10       IF WIIX=1

               SET WIIEN=$ORDER(@VALMAR@("IDX",+WIIY,""))

               DO FILE(WIIEN,1)

 +11       IF WIIX>1

               FOR WIIZ=1:1:WIIX

                   SET WIILN=$PIECE(WIIY,",",WIIZ)

                   SET WIIEN=$ORDER(@VALMAR@("IDX",+WIILN,""))

                   DO FILE(WIIEN,1)

 +12       WRITE !,"Record"_$SELECT(WIIX>1:"s ",1:" "),WIIY," will be marked pending"

 +13      ; clean up the LM display variables and reload the list

 +14       DO CLEAN^VALM10

           DO INIT^WIILM03

           QUIT

 +15       QUIT

PD3       ; reset status to pending from deleted

 +1       ; quit if there aren't any entries on the current list

           if VALMCNT<1

               QUIT

 +2        KILL DIR

           SET DIR(0)="LO^"_VALMBG_":"_VALMLST

           SET DIR("A")="Select records to remove"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               QUIT

 +3       ; save the DIR processed response

           SET WIIY=Y

 +4       ; check if multiple records were selected by counting the number of "," pieces using WIIX

 +5       ; if WIIX has more than one comma delimited value ForLoop through the WIIY setting WIIZ to

 +6       ; the next number in list. WIILN set to reference LM line number and WIIEN to the file 987.5

 +7       ; IEN set in LM array "IDX" x-ref.

 +8       ; FM API called to update the status field to "1:Pending facility approval"

 +9        SET WIIX=$LENGTH(WIIY,",")-1

 +10       IF WIIX=1

               SET WIIEN=$ORDER(@VALMAR@("IDX",+WIIY,""))

               DO FILE(WIIEN,1)

 +11       IF WIIX>1

               FOR WIIZ=1:1:WIIX

                   SET WIILN=$PIECE(WIIY,",",WIIZ)

                   SET WIIEN=$ORDER(@VALMAR@("IDX",+WIILN,""))

                   DO FILE(WIIEN,1)

 +12       WRITE !,"Records ",WIIY," will be marked pending"

 +13      ; clean up the LM display variables and reload the list

 +14       DO CLEAN^VALM10

           DO INIT^WIILM04

           QUIT

 +15       QUIT

FILE(DA,STATUS) ; file status change

 +1        if '+DA

               QUIT

 +2        SET DIE="^WII(987.5,"

           SET DR="8///"_+STATUS_";10///"_$GET(DUZ)_";11///"_DT

           LOCK +^WII(987.5,DA):0

           IF $TEST

               DO ^DIE

               LOCK -^WII(987.5,DA)

 +3        QUIT

ZAP       ;

 +1        KILL DIE,DIRUT,DA,Y,X,DR,STATUS,WIILN,VALMAR,VALMBG,VALMCNT,VALMLST,WIIEN,WIILN,WIINODE,WIIX,WIIY,WIIZ,Y

WIILM01.m