WIIGATD ;VISN20/WDE/WHN WII-EXTRACT DATA ; [6/26/08 07:21am]
;;1.0;Wounded Injured and Ill Warriors;**1**;06/26/2008;Build 28;
;API used see Appendix A Message Server Protocol
;http://www.domain.ext/vdl/documents/Infrastructure/Mailman/xm_8_0_developerguide.pdf
; INTEGRATION REFERENCE #3041 All fields can be accessed/edited using FileMan tools.
; ACCESS TO FILE 20 NAME COMPONENTS VA(20
;Once the data is approved at the local facility this routine is called from the exit action of option
;WII REVIEW ADT EVENTS. The function is to send the data off to the single collection point.
;
;Data is sent to the server that is entered in file WII PARAMETERS (#987.6) field 1.
; The otion to review the data is the series of WIILM* routines.
EN ;Entry Point
D CLEAN
S (WIICNT,WIIENT)=0 F S WIIENT=$O(^WII(987.5,"C",2,WIIENT)) Q:(WIIENT="")!('+WIIENT) D
. D BUILD
. Q
I $D(^TMP($J))>0 D XMB
D CLEAN
Q
BUILD ;
S WIIDATA=$G(^WII(987.5,WIIENT,0)) Q:WIIDATA=""
S WIIP2=$P(WIIDATA,U,2) ;PATIENT
S WIIP3=$P(WIIDATA,U,3) ;SSN
S WIIP5=$P(WIIDATA,U,5) ;FACILITY
S WIIP6=$P(WIIDATA,U,6) ;ADMISSION DATE
S WIIP7=$P(WIIDATA,U,7) ;DISCHARGE DATE
S WIIP8=$P(WIIDATA,U,8) ;ICN
S WIIP10=$P(WIIDATA,U,10) ;DATE COLLECTED AT THE FACILITY
S WIIDATA=$G(^WII(987.5,WIIENT,1)) ;SUBSCRIPT 1
S WIIP11=$P(WIIDATA,U,1) ;PATIENTS ZIP CODE
S WIIP12=$P(WIIDATA,U,2) ;DATE OF BIRTH
S WIIP13=$P(WIIDATA,U,3) ;GENDER
S WIIP14=$P(WIIDATA,U,4) ;QUALIFYING ELIGIBILITY
S WIIP15=DT ;DATE GOING TO THE REPOSITORY
S WIIDFN=$P($G(WIIDATA),U,6)
;NAMES FROM VA(20 COMPONETS
S WIICOMP=$$GET1^DIQ(2,WIIDFN,1.01,"I")
;INTEGRATION REFERENCE #3041
S WIICOMA=$$GET1^DIQ(20,WIICOMP,1,"E") S:WIICOMA="" WIICOMA=$P($G(WIIP2),",",1) ;"ERROR LAST NAME"
S WIICOMB=$$GET1^DIQ(20,WIICOMP,2,"E") S:WIICOMB="" WIICOMB=$P($G(WIIP2),",",2) ;"ERROR FIRST NAME"
S WIICOMC=$$GET1^DIQ(20,WIICOMP,3,"E") S:WIICOMC="" WIICOMC=" "
;NO THE REFERENCE TO 987.7 IS NOT A TYPO THIS IS THE FILE NUMBER THAT THIS DATA STRING IS GOING TO POPULATE
S WIISTRG="987.7^"_WIIP5_U_WIICOMA_U_WIIP3_U_WIIP6_U_WIIP7_U_WIIP8_U_WIIP10_U_1_U_WIIP11_U_WIIP12_U_WIIP13_U_WIIP14_U_WIIP15_U_WIICOMB_U_WIICOMC
S WIICNT=WIICNT+1
S ^TMP($J,WIICNT,0)=WIISTRG
S DIE="^WII(987.5,",DA=WIIENT,DR="8///4"
D ^DIE
Q
XMB ;
; XMY..........RECIPIENTS OF MSG
; XMDUZ........MESSAGE SENDER
; XMSUB........MESSAGE SUBJECT
; XMTEXT.......MESSAGE TEXT
; below line send output to XMB
;API used see Appendix A Message Server Protocol
S WIIREV=$$GET1^DIQ(987.6,1,1,"I") ;NATIONAL REVIEWER OF THE DATA BEFORE IT GOES OFF TO DEFAS
S XMY(WIIREV)=""
S XMDUZ=.5,XMSUB=^DD("SITE")_" - Admissions/Discharges",XMTEXT="^TMP($J," D ^XMD,KILL^XM
Q
CLEAN ;
K XMDUZ,XMY,WIIREV
K ^TMP($J)
K WIIENT,WIICNT,WIIDATA,WIIP2,WIIP3,WIIP4,WIIP5,WIIP6,WIIP7,WIIP8,WIIP9,WIIP10,WIISTRG
K DA,DIC,DIE,DR,XMDUZ,XMSUB,XMTEXT,WIIP15
K WIIP11,WIIP12,WIIP13,WIIP14,WIIP2,WIICOMP,WIICOMA,WIICOMB,WIICOMC,WIIDFN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWIIGATD 3023 printed Dec 13, 2024@02:46:29 Page 2
WIIGATD ;VISN20/WDE/WHN WII-EXTRACT DATA ; [6/26/08 07:21am]
+1 ;;1.0;Wounded Injured and Ill Warriors;**1**;06/26/2008;Build 28;
+2 ;API used see Appendix A Message Server Protocol
+3 ;http://www.domain.ext/vdl/documents/Infrastructure/Mailman/xm_8_0_developerguide.pdf
+4 ; INTEGRATION REFERENCE #3041 All fields can be accessed/edited using FileMan tools.
+5 ; ACCESS TO FILE 20 NAME COMPONENTS VA(20
+6 ;Once the data is approved at the local facility this routine is called from the exit action of option
+7 ;WII REVIEW ADT EVENTS. The function is to send the data off to the single collection point.
+8 ;
+9 ;Data is sent to the server that is entered in file WII PARAMETERS (#987.6) field 1.
+10 ; The otion to review the data is the series of WIILM* routines.
EN ;Entry Point
+1 DO CLEAN
+2 SET (WIICNT,WIIENT)=0
FOR
SET WIIENT=$ORDER(^WII(987.5,"C",2,WIIENT))
if (WIIENT="")!('+WIIENT)
QUIT
Begin DoDot:1
+3 DO BUILD
+4 QUIT
End DoDot:1
+5 IF $DATA(^TMP($JOB))>0
DO XMB
+6 DO CLEAN
+7 QUIT
BUILD ;
+1 SET WIIDATA=$GET(^WII(987.5,WIIENT,0))
if WIIDATA=""
QUIT
+2 ;PATIENT
SET WIIP2=$PIECE(WIIDATA,U,2)
+3 ;SSN
SET WIIP3=$PIECE(WIIDATA,U,3)
+4 ;FACILITY
SET WIIP5=$PIECE(WIIDATA,U,5)
+5 ;ADMISSION DATE
SET WIIP6=$PIECE(WIIDATA,U,6)
+6 ;DISCHARGE DATE
SET WIIP7=$PIECE(WIIDATA,U,7)
+7 ;ICN
SET WIIP8=$PIECE(WIIDATA,U,8)
+8 ;DATE COLLECTED AT THE FACILITY
SET WIIP10=$PIECE(WIIDATA,U,10)
+9 ;SUBSCRIPT 1
SET WIIDATA=$GET(^WII(987.5,WIIENT,1))
+10 ;PATIENTS ZIP CODE
SET WIIP11=$PIECE(WIIDATA,U,1)
+11 ;DATE OF BIRTH
SET WIIP12=$PIECE(WIIDATA,U,2)
+12 ;GENDER
SET WIIP13=$PIECE(WIIDATA,U,3)
+13 ;QUALIFYING ELIGIBILITY
SET WIIP14=$PIECE(WIIDATA,U,4)
+14 ;DATE GOING TO THE REPOSITORY
SET WIIP15=DT
+15 SET WIIDFN=$PIECE($GET(WIIDATA),U,6)
+16 ;NAMES FROM VA(20 COMPONETS
+17 SET WIICOMP=$$GET1^DIQ(2,WIIDFN,1.01,"I")
+18 ;INTEGRATION REFERENCE #3041
+19 ;"ERROR LAST NAME"
SET WIICOMA=$$GET1^DIQ(20,WIICOMP,1,"E")
if WIICOMA=""
SET WIICOMA=$PIECE($GET(WIIP2),",",1)
+20 ;"ERROR FIRST NAME"
SET WIICOMB=$$GET1^DIQ(20,WIICOMP,2,"E")
if WIICOMB=""
SET WIICOMB=$PIECE($GET(WIIP2),",",2)
+21 SET WIICOMC=$$GET1^DIQ(20,WIICOMP,3,"E")
if WIICOMC=""
SET WIICOMC=" "
+22 ;NO THE REFERENCE TO 987.7 IS NOT A TYPO THIS IS THE FILE NUMBER THAT THIS DATA STRING IS GOING TO POPULATE
+23 SET WIISTRG="987.7^"_WIIP5_U_WIICOMA_U_WIIP3_U_WIIP6_U_WIIP7_U_WIIP8_U_WIIP10_U_1_U_WIIP11_U_WIIP12_U_WIIP13_U_WIIP14_U_WIIP15_U_WIICOMB_U_WIICOMC
+24 SET WIICNT=WIICNT+1
+25 SET ^TMP($JOB,WIICNT,0)=WIISTRG
+26 SET DIE="^WII(987.5,"
SET DA=WIIENT
SET DR="8///4"
+27 DO ^DIE
+28 QUIT
XMB ;
+1 ; XMY..........RECIPIENTS OF MSG
+2 ; XMDUZ........MESSAGE SENDER
+3 ; XMSUB........MESSAGE SUBJECT
+4 ; XMTEXT.......MESSAGE TEXT
+5 ; below line send output to XMB
+6 ;API used see Appendix A Message Server Protocol
+7 ;NATIONAL REVIEWER OF THE DATA BEFORE IT GOES OFF TO DEFAS
SET WIIREV=$$GET1^DIQ(987.6,1,1,"I")
+8 SET XMY(WIIREV)=""
+9 SET XMDUZ=.5
SET XMSUB=^DD("SITE")_" - Admissions/Discharges"
SET XMTEXT="^TMP($J,"
DO ^XMD
DO KILL^XM
+10 QUIT
CLEAN ;
+1 KILL XMDUZ,XMY,WIIREV
+2 KILL ^TMP($JOB)
+3 KILL WIIENT,WIICNT,WIIDATA,WIIP2,WIIP3,WIIP4,WIIP5,WIIP6,WIIP7,WIIP8,WIIP9,WIIP10,WIISTRG
+4 KILL DA,DIC,DIE,DR,XMDUZ,XMSUB,XMTEXT,WIIP15
+5 KILL WIIP11,WIIP12,WIIP13,WIIP14,WIIP2,WIICOMP,WIICOMA,WIICOMB,WIICOMC,WIIDFN
+6 QUIT
