WIISERV ;VISN20/WDE/WHN/WII-EXTRACT DATA ; [6/26/08 07:21am]
;;1.0;Wounded Injured and Ill Warriors;**1**;06/26/2008;Build 28;
;; WII ADT SERVER MAIL SERVER CALLED S.WII ADT SERVER
;API used see Appendix A Message Server Protocol
;http://www.domain.ext/vdl/documents/Infrastructure/Mailman/xm_8_0_developerguide.pdf
;UNLOAD^WIISERV
UNLOAD ;Entry Point
;http://www.domain.ext/vdl/documents/Infrastructure/Mailman/xm_8_0_developerguide.pdf
F WII=1:1 X XMREC Q:(XMER=-1) D
.I $P($G(XMRG),U,1)="987.7" D DATA1
.I $P($G(XMRG),U,1)="987.8 DATA" D DATA2
D CLEAN
Q
DATA1 ;
;
S WIIDATA=$G(XMRG)
S WIIP1=$P($G(WIIDATA),U,2) ;STATION
S WIIP2=$P($G(WIIDATA),U,3) ;PATIENT LAST NAME ONLY
S WIIP3=$P($G(WIIDATA),U,4) ;SSN
S WIIP4=$P($G(WIIDATA),U,5) ;ADMIT DATE
S WIIP5=$P($G(WIIDATA),U,6) ;DISCHARGE DATE
S WIIP6=$P($G(WIIDATA),U,7) ;ICN
S WIIP7=$P($G(WIIDATA),U,8) ;ORIG COLLECTION DATE
S WIIP8=$P($G(WIIDATA),U,9) ;STATUS
S WIIP10=$P($G(WIIDATA),U,10) ;PATIENTS ZIP CODE
S WIIP11=$P($G(WIIDATA),U,11) ;DATE OF BIRTH
S WIIP12=$P($G(WIIDATA),U,12) ;GENDER
S WIIP13=$P($G(WIIDATA),U,13) ;QUALIFYING ELIGIBILITY
S WIIP16=$P($G(WIIDATA),U,15) ;first name NAME COMP FIRST NAME VERY LONG MAYBE
S WIIP17=$P($G(WIIDATA),U,16) ;MIDDLE NAME
;DIC ; BUILD ENTRY
S DIC="^WII(987.7,"
S DIC(0)="Z"
S X=$P($G(^WII(987.7,0)),U,3) S:X="" X=0 S X=X+1
S WIINOW=$$NOW^XLFDT
S DIC("DR")=".01///"_X
D FILE^DICN
K X,DA,WIINOW
I Y>0 D
.S DA=$P($G(Y),U,1) Q:DA=""
.S DIE=DIC
.S DR="1///"_WIIP1_";2///"_WIIP2_";3///"_WIIP3_";4///"_WIIP4_";5///"_WIIP5_";6///"_WIIP6_";7///"_WIIP7_";9///"_WIIP8
.S DR=DR_";10///"_WIIP10_";11///"_WIIP11_";12///"_WIIP12_";13///"_WIIP13_";14///"_DT
.D ^DIE
.K DR
.S DR="16///"_WIIP16_";17///"_WIIP17
.D ^DIE
.K X,DA,Y,DR
.Q
Q
CLEAN ;
K WIIP1,WIIP2,WIIP3,WIIP4,WIIP5,WIIP6,WIIP7,WIIP8,Y,DA,X,DIE,DIC,WIINOW,X
K WIIP10,WIIP11,WIIP12,WIIP13,DA,DIE,DIC,Y,X,WII,WIIDATA,XMER,XMREC,XMRG
K WIIP15,WIIP16,WIIP17
Q
DATA2 ;
;S ^TMP("DAVE",WIICNT)=XMRG
;DIC ; BUILD ENTRY
S DIC="^WII(987.8,"
S DIC(0)="Z"
S X=$P($G(^WII(987.8,0)),U,3) S:X="" X=0 S X=X+1
S WIINOW=$$NOW^XLFDT
S DIC("DR")=".01///"_X
D FILE^DICN
K X,DA,WIINOW
I Y>0 D
.S DA=$P($G(Y),U,1) Q:DA=""
.S DIE=DIC
.;;SITE ^ COUNT ^ DATE RAN ^ Start of reporting period ^ End of REPORTING PERIOD
.S WIIDATA=$G(XMRG)
.S WIIP1=$P(WIIDATA,U,2)
.S WIIP2=$P(WIIDATA,U,3)
.S WIIP3=$P(WIIDATA,U,4)
.S WIIP4=$P(WIIDATA,U,5)
.S WIIP5=$P(WIIDATA,U,6)
.S DR="1///"_WIIP1_";2///"_WIIP2_";3///"_WIIP3_";4///"_WIIP4_";5///"_WIIP5
.D ^DIE
.K X,DA,Y,DR
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWIISERV 2668 printed Dec 13, 2024@02:46:36 Page 2
WIISERV ;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 ;; WII ADT SERVER MAIL SERVER CALLED S.WII ADT SERVER
+3 ;API used see Appendix A Message Server Protocol
+4 ;http://www.domain.ext/vdl/documents/Infrastructure/Mailman/xm_8_0_developerguide.pdf
+5 ;UNLOAD^WIISERV
UNLOAD ;Entry Point
+1 ;http://www.domain.ext/vdl/documents/Infrastructure/Mailman/xm_8_0_developerguide.pdf
+2 FOR WII=1:1
XECUTE XMREC
if (XMER=-1)
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(XMRG),U,1)="987.7"
DO DATA1
+4 IF $PIECE($GET(XMRG),U,1)="987.8 DATA"
DO DATA2
End DoDot:1
+5 DO CLEAN
+6 QUIT
DATA1 ;
+1 ;
+2 SET WIIDATA=$GET(XMRG)
+3 ;STATION
SET WIIP1=$PIECE($GET(WIIDATA),U,2)
+4 ;PATIENT LAST NAME ONLY
SET WIIP2=$PIECE($GET(WIIDATA),U,3)
+5 ;SSN
SET WIIP3=$PIECE($GET(WIIDATA),U,4)
+6 ;ADMIT DATE
SET WIIP4=$PIECE($GET(WIIDATA),U,5)
+7 ;DISCHARGE DATE
SET WIIP5=$PIECE($GET(WIIDATA),U,6)
+8 ;ICN
SET WIIP6=$PIECE($GET(WIIDATA),U,7)
+9 ;ORIG COLLECTION DATE
SET WIIP7=$PIECE($GET(WIIDATA),U,8)
+10 ;STATUS
SET WIIP8=$PIECE($GET(WIIDATA),U,9)
+11 ;PATIENTS ZIP CODE
SET WIIP10=$PIECE($GET(WIIDATA),U,10)
+12 ;DATE OF BIRTH
SET WIIP11=$PIECE($GET(WIIDATA),U,11)
+13 ;GENDER
SET WIIP12=$PIECE($GET(WIIDATA),U,12)
+14 ;QUALIFYING ELIGIBILITY
SET WIIP13=$PIECE($GET(WIIDATA),U,13)
+15 ;first name NAME COMP FIRST NAME VERY LONG MAYBE
SET WIIP16=$PIECE($GET(WIIDATA),U,15)
+16 ;MIDDLE NAME
SET WIIP17=$PIECE($GET(WIIDATA),U,16)
+17 ;DIC ; BUILD ENTRY
+18 SET DIC="^WII(987.7,"
+19 SET DIC(0)="Z"
+20 SET X=$PIECE($GET(^WII(987.7,0)),U,3)
if X=""
SET X=0
SET X=X+1
+21 SET WIINOW=$$NOW^XLFDT
+22 SET DIC("DR")=".01///"_X
+23 DO FILE^DICN
+24 KILL X,DA,WIINOW
+25 IF Y>0
Begin DoDot:1
+26 SET DA=$PIECE($GET(Y),U,1)
if DA=""
QUIT
+27 SET DIE=DIC
+28 SET DR="1///"_WIIP1_";2///"_WIIP2_";3///"_WIIP3_";4///"_WIIP4_";5///"_WIIP5_";6///"_WIIP6_";7///"_WIIP7_";9///"_WIIP8
+29 SET DR=DR_";10///"_WIIP10_";11///"_WIIP11_";12///"_WIIP12_";13///"_WIIP13_";14///"_DT
+30 DO ^DIE
+31 KILL DR
+32 SET DR="16///"_WIIP16_";17///"_WIIP17
+33 DO ^DIE
+34 KILL X,DA,Y,DR
+35 QUIT
End DoDot:1
+36 QUIT
CLEAN ;
+1 KILL WIIP1,WIIP2,WIIP3,WIIP4,WIIP5,WIIP6,WIIP7,WIIP8,Y,DA,X,DIE,DIC,WIINOW,X
+2 KILL WIIP10,WIIP11,WIIP12,WIIP13,DA,DIE,DIC,Y,X,WII,WIIDATA,XMER,XMREC,XMRG
+3 KILL WIIP15,WIIP16,WIIP17
+4 QUIT
DATA2 ;
+1 ;S ^TMP("DAVE",WIICNT)=XMRG
+2 ;DIC ; BUILD ENTRY
+3 SET DIC="^WII(987.8,"
+4 SET DIC(0)="Z"
+5 SET X=$PIECE($GET(^WII(987.8,0)),U,3)
if X=""
SET X=0
SET X=X+1
+6 SET WIINOW=$$NOW^XLFDT
+7 SET DIC("DR")=".01///"_X
+8 DO FILE^DICN
+9 KILL X,DA,WIINOW
+10 IF Y>0
Begin DoDot:1
+11 SET DA=$PIECE($GET(Y),U,1)
if DA=""
QUIT
+12 SET DIE=DIC
+13 ;;SITE ^ COUNT ^ DATE RAN ^ Start of reporting period ^ End of REPORTING PERIOD
+14 SET WIIDATA=$GET(XMRG)
+15 SET WIIP1=$PIECE(WIIDATA,U,2)
+16 SET WIIP2=$PIECE(WIIDATA,U,3)
+17 SET WIIP3=$PIECE(WIIDATA,U,4)
+18 SET WIIP4=$PIECE(WIIDATA,U,5)
+19 SET WIIP5=$PIECE(WIIDATA,U,6)
+20 SET DR="1///"_WIIP1_";2///"_WIIP2_";3///"_WIIP3_";4///"_WIIP4_";5///"_WIIP5
+21 DO ^DIE
+22 KILL X,DA,Y,DR
+23 QUIT
End DoDot:1
+24 QUIT
