AMERPRE ; IHS/OIT/SCR - PRE-INIT ROUTINE FOR ERS V3.0 ;
;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
EN ;ENTRY POINT FROM KIDS BUILD AMER*3.0
;
Q:$G(^AMERVSIT(0))="" ;if this is a fist time installation, don't do pre-init stuff
EDITMAP ;
; TASK 1: REMOVE UNWANTED ENTRIES FROM "ER INPUT MAP" requirement 4
; ALGORITHM
; FIRST: LOOK UP THE ENTRY IN "ER INPUT MAP" FOR THE TAG THAT
; HAS BEEN REMOVED
; 1. ;QD51 ; SECOND VEHICLE INVOLVED
; 2. ;QD52 ; SECOND VEHICLE DRIVER'S NAME
; 3. ;QD53 ; SV DRIVER INSURANCE COMPANY
; 4. ;QD54 ; SECOND VEHICLE DRIVER POLICY NUMBER
; 5. ;QD55 ; SECOND VEHICLE OWNER'S NAME
; 5. ;QD56 ; SECOND VEHICLE OWNER'S INSURANCE COMPANY
; 6. ;QD57 ; SECOND VEHICLE OWNER'S POLICY NUMBER
; 7. ;QD61 ; RESPONSIBLE PARTY
; 8. ;QD62 ; NAME OF RESPONSIBLE PARTY
; 9. ;QD63 ; ADDRESS OF RESPONSIBLE PARTY
; 10. ;QD64 ; PHONE OF RESPONSIBLE PARTY
; 11. ;QD70 ; BRIEF DESCRIPTION OF WHAT HAPPENED
; 12. ;QD8 ; TRAUMA SURGEON NOTIFIED
; 13. ;QD9 ; TRAUMA SURGEON TIME
; 14. ;QD7 ; INDUSTRY
; 15. ;QD4 ; SELECT DRUGS
; 16. ;QD3 ; SUBSTANCE ABUSE
; NEXT : DELTE THAT ENTRY FROM THE GLOBAL
; FINALY: RE-INDEX THE FILE TO GET RID OF "BAD" CROSS-REFERENCES
N AMERTAGS,AMERTAG,AMERIEN,AMERI,AMERSTRG,AMERMODE,AMERCAT,AMEROPT
S AMERTAGS="QD8^QD9^QD7^QD4^QD51^QD52^QD53^QD54^QD55^QD56^QD57"
S AMERTAGS=AMERTAGS_"^QD61^QD62^QD63^QD64^QD70^QD3"
S DIC="^AMER(2.3,"
S DIC(0)="X"
S DIK="^AMER(2.3,"
F AMERI=1:1:17 D
.S AMERTAG=$P(AMERTAGS,U,AMERI)
.S X=AMERTAG
.D ^DIC
.S AMERIEN=$P($G(Y),U,1)
.I AMERIEN>0 D
..S DA=AMERIEN
..D ^DIK
..D IX^DIK
..Q
.Q
EDITMETA ;
; TASK 2: REMOVE UNWANTED ENTRY FROM ER METADATA ^AMER(2.2
; FIRST: LOOK UP THE ENTRY FOR "ALCOHOL RELATED"
S AMERTAG="ALCOHOL RELATED",AMERIEN=0
S AMERIEN=$O(^AMER(2.2,"B",AMERTAG,AMERIEN))
I AMERIEN'="" D
.S DIK="^AMER(2.2,"
.Q:AMERIEN<0
.S DA=AMERIEN
.D ^DIK
.D IX^DIK
.Q
UPDTOPT ;
; TASK 3: UPDATE ER CATEGORY FILE TO INCLUDE "ER CONSULTANT TYPE" CATEGORY
S DIC="^AMER(2,"
S DIC(0)="XL"
S X="ER CONSULTANT"
D ^DIC
; TASK 4: UPDATE ER OPTIONS FILE TO INCLUDE THESE ER CATEGORY "MODE OF TRANSPORT" ENTRIES
; FIXED WING, GROUND, ROTARY WING.
ADDMODE ;
S AMERSTRG="FIXED WING^GROUND^ROTARY WING"
S AMERMODE=0
S AMERMODE=$O(^AMER(2,"B","MODE OF TRANSPORT",AMERMODE))
S DIC(0)="XL"
S DIC="^AMER(3,"
F AMERI=1:1:3 D
.S X=$P(AMERSTRG,U,AMERI)
.D ^DIC
.Q:Y<0
.S DA=$P(Y,U,1)
.S DIE=DIC,DR="1////"_AMERMODE
.D ^DIE
.Q
Q
POSTINST ;IHS/OIT/SCR 2/20/09 added to force entry of HOME DISPOSITION into ER OPTIONS file
S AMERDISP=0
S AMERDONE=0
S AMERDISP=$O(^AMER(2,"B","DISPOSITION",AMERDISP)) ;THIS IS THE POINTER TO DISPOSITION CATEGORY
S AMERHOME=0
F S AMERHOME=$O(^AMER(3,AMERHOME)) Q:((AMERHOME="AC")!AMERDONE) D
.W !,$P(^AMER(3,AMERHOME,0),"^",1)," ",$P(^AMER(3,AMERHOME,0),"^",2)
.I $P(^AMER(3,AMERHOME,0),"^",1)="HOME"&($P(^AMER(3,AMERHOME,0),"^",2)=AMERDISP) S AMERDONE=1
.Q
Q:AMERDONE ;THIS DISPOSITION ALREADY EXISTS
S DIC(0)=""
S DIC="^AMER(3,"
S X="HOME"
D FILE^DICN
Q:Y<0
S DA=$P(Y,U,1)
S DIE=DIC
S DR="1////"_AMERDISP
D ^DIE
Q
AMERPRE ; IHS/OIT/SCR - PRE-INIT ROUTINE FOR ERS V3.0 ;
+1 ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
EN ;ENTRY POINT FROM KIDS BUILD AMER*3.0
+1 ;
+2 ;if this is a fist time installation, don't do pre-init stuff
IF $GET(^AMERVSIT(0))=""
QUIT
EDITMAP ;
+1 ; TASK 1: REMOVE UNWANTED ENTRIES FROM "ER INPUT MAP" requirement 4
+2 ; ALGORITHM
+3 ; FIRST: LOOK UP THE ENTRY IN "ER INPUT MAP" FOR THE TAG THAT
+4 ; HAS BEEN REMOVED
+5 ; 1. ;QD51 ; SECOND VEHICLE INVOLVED
+6 ; 2. ;QD52 ; SECOND VEHICLE DRIVER'S NAME
+7 ; 3. ;QD53 ; SV DRIVER INSURANCE COMPANY
+8 ; 4. ;QD54 ; SECOND VEHICLE DRIVER POLICY NUMBER
+9 ; 5. ;QD55 ; SECOND VEHICLE OWNER'S NAME
+10 ; 5. ;QD56 ; SECOND VEHICLE OWNER'S INSURANCE COMPANY
+11 ; 6. ;QD57 ; SECOND VEHICLE OWNER'S POLICY NUMBER
+12 ; 7. ;QD61 ; RESPONSIBLE PARTY
+13 ; 8. ;QD62 ; NAME OF RESPONSIBLE PARTY
+14 ; 9. ;QD63 ; ADDRESS OF RESPONSIBLE PARTY
+15 ; 10. ;QD64 ; PHONE OF RESPONSIBLE PARTY
+16 ; 11. ;QD70 ; BRIEF DESCRIPTION OF WHAT HAPPENED
+17 ; 12. ;QD8 ; TRAUMA SURGEON NOTIFIED
+18 ; 13. ;QD9 ; TRAUMA SURGEON TIME
+19 ; 14. ;QD7 ; INDUSTRY
+20 ; 15. ;QD4 ; SELECT DRUGS
+21 ; 16. ;QD3 ; SUBSTANCE ABUSE
+22 ; NEXT : DELTE THAT ENTRY FROM THE GLOBAL
+23 ; FINALY: RE-INDEX THE FILE TO GET RID OF "BAD" CROSS-REFERENCES
+24 NEW AMERTAGS,AMERTAG,AMERIEN,AMERI,AMERSTRG,AMERMODE,AMERCAT,AMEROPT
+25 SET AMERTAGS="QD8^QD9^QD7^QD4^QD51^QD52^QD53^QD54^QD55^QD56^QD57"
+26 SET AMERTAGS=AMERTAGS_"^QD61^QD62^QD63^QD64^QD70^QD3"
+27 SET DIC="^AMER(2.3,"
+28 SET DIC(0)="X"
+29 SET DIK="^AMER(2.3,"
+30 FOR AMERI=1:1:17
Begin DoDot:1
+31 SET AMERTAG=$PIECE(AMERTAGS,U,AMERI)
+32 SET X=AMERTAG
+33 DO ^DIC
+34 SET AMERIEN=$PIECE($GET(Y),U,1)
+35 IF AMERIEN>0
Begin DoDot:2
+36 SET DA=AMERIEN
+37 DO ^DIK
+38 DO IX^DIK
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
EDITMETA ;
+1 ; TASK 2: REMOVE UNWANTED ENTRY FROM ER METADATA ^AMER(2.2
+2 ; FIRST: LOOK UP THE ENTRY FOR "ALCOHOL RELATED"
+3 SET AMERTAG="ALCOHOL RELATED"
SET AMERIEN=0
+4 SET AMERIEN=$ORDER(^AMER(2.2,"B",AMERTAG,AMERIEN))
+5 IF AMERIEN'=""
Begin DoDot:1
+6 SET DIK="^AMER(2.2,"
+7 IF AMERIEN<0
QUIT
+8 SET DA=AMERIEN
+9 DO ^DIK
+10 DO IX^DIK
+11 QUIT
End DoDot:1
UPDTOPT ;
+1 ; TASK 3: UPDATE ER CATEGORY FILE TO INCLUDE "ER CONSULTANT TYPE" CATEGORY
+2 SET DIC="^AMER(2,"
+3 SET DIC(0)="XL"
+4 SET X="ER CONSULTANT"
+5 DO ^DIC
+6 ; TASK 4: UPDATE ER OPTIONS FILE TO INCLUDE THESE ER CATEGORY "MODE OF TRANSPORT" ENTRIES
+7 ; FIXED WING, GROUND, ROTARY WING.
ADDMODE ;
+1 SET AMERSTRG="FIXED WING^GROUND^ROTARY WING"
+2 SET AMERMODE=0
+3 SET AMERMODE=$ORDER(^AMER(2,"B","MODE OF TRANSPORT",AMERMODE))
+4 SET DIC(0)="XL"
+5 SET DIC="^AMER(3,"
+6 FOR AMERI=1:1:3
Begin DoDot:1
+7 SET X=$PIECE(AMERSTRG,U,AMERI)
+8 DO ^DIC
+9 IF Y<0
QUIT
+10 SET DA=$PIECE(Y,U,1)
+11 SET DIE=DIC
SET DR="1////"_AMERMODE
+12 DO ^DIE
+13 QUIT
End DoDot:1
+14 QUIT
POSTINST ;IHS/OIT/SCR 2/20/09 added to force entry of HOME DISPOSITION into ER OPTIONS file
+1 SET AMERDISP=0
+2 SET AMERDONE=0
+3 ;THIS IS THE POINTER TO DISPOSITION CATEGORY
SET AMERDISP=$ORDER(^AMER(2,"B","DISPOSITION",AMERDISP))
+4 SET AMERHOME=0
+5 FOR
SET AMERHOME=$ORDER(^AMER(3,AMERHOME))
IF ((AMERHOME="AC")!AMERDONE)
QUIT
Begin DoDot:1
+6 WRITE !,$PIECE(^AMER(3,AMERHOME,0),"^",1)," ",$PIECE(^AMER(3,AMERHOME,0),"^",2)
+7 IF $PIECE(^AMER(3,AMERHOME,0),"^",1)="HOME"&($PIECE(^AMER(3,AMERHOME,0),"^",2)=AMERDISP)
SET AMERDONE=1
+8 QUIT
End DoDot:1
+9 ;THIS DISPOSITION ALREADY EXISTS
IF AMERDONE
QUIT
+10 SET DIC(0)=""
+11 SET DIC="^AMER(3,"
+12 SET X="HOME"
+13 DO FILE^DICN
+14 IF Y<0
QUIT
+15 SET DA=$PIECE(Y,U,1)
+16 SET DIE=DIC
+17 SET DR="1////"_AMERDISP
+18 DO ^DIE
+19 QUIT
